[Jscheme-user] hack of the day - predicate compiler

[Ken A. <kan...@bb...>]

;;; KRA 18JUN04:

{

Tim and i have been talking about writing a "book", which would show
examples of how things Java programmers like to do can be done more
simply in JScheme.  Here's an example of something fairly hard to do
in Java, though it might not be too hard in other Java scripting
languages.  Maybe these are the kind of example we should focus on.

One of the things i worked on this week was a gui for filtering a
collection of objects.  This task comes up fairly often, there are 3
projects i know about in my department that do some form of filtering
currently.

The gui produces the body of an application specific filter.  Here's
an example:

(and (or (tag GeoPoint2D) (tag relativePositionOf))
     (or ("icao" "starts with" "K")
         ("icao" "starts with" "L")))

Notice we meet the requirement of reading and writing this to a file
mostly for free.  Try that in XML.

The compiler for this predicate produces the equlivalent of the code:

(lambda (x)
  (and (or (xTokensContain "GeoPoint2D" x)
           (xTokensContain "relativePositionOf" x))
       (or (.startsWith (.getIcaoId x) "K")
           (.startsWith (.getIcaoId x) "L"))))

which is simply passed to (filter) on the list of objects to get the
filtered result.  Not bad for a simple 50 line compiler, which seems
plenty fast enough.

}

(load "elf/basic.scm")
(define (compilePredicate sexp)
  (define (compile sexp)
    (case (car sexp)
      ((and) `(and ,@(map compile (cdr sexp))))
      ((or) `(or ,@(map compile (cdr sexp))))
      ((tag) `(xTokensContain ,(.toString (second sexp)) x))
      (else
       (let ((field (cadr (assoc (car sexp) features)))
             (op (cadr (assoc (second sexp) operators)))
             (value (.toUpperCase (third sexp))))
         `(,op (,field x) ,value)))))
  (eval `(lambda (x) ,(compile sexp))))

(define
  features
  (by 2
      '(
       "accountId" .getAccountId
       "cnsLocationId" .getCnsLocationId
       "icao" .getIcaoId
       "icaoName" .getIcaoName
       "xCancelDtg" .getXCancelDtg
       "xEffectiveDtg" .getXEffectiveDtg
       "xExpireDtg" .getXExpireDtg
       "xId" .getXId
       "xLastmodDtg" .getXLastmodDtg
       "xNrc" .getXNrc
       "xPart" .getXPart
       "Qcode" .getXQcode
       "xText" .getXText
       "sourceId" .getSourceId
       "canceling" .getCanceling
       "isqCanceledDtg" .getIsqCanceledDtg
       "damlAnnotation" .getDamlAnnotation
       "inactive" .getInactive
       "runways" .getRunways
       "simplification" .getSimplification
       "regionX" .getRegionX
       )))


(define operators
  ;; Operators are binary. 
  (by 2
      '(
        "is" .equals
        "is not" (lambda (a b) (not (.equals a b)))
        "is null" (lambda (a ignore) (isNull a))
        "contains" contains
        "starts with" .startsWith
        "doesn't start with" (lambda (a b) (not (.startsWith a b)))
        "ends with"   .endsWith
        "doesn't end with" (lambda (a b) (not (.endsWith a b)))
        "matches" .matches)))