;;;; -*- mode:Lisp; package:user -*- ;;;;
;;;; Created: 10 December 1992
(compile-tree interface
  (brnchs
    (count > objects if-end-rtn
       (db-call `(db-count ,objects)))
    (how many > objects are there if-end-rtn
       (db-call `(db-count ,objects)))
    (> enumerate > objects if-end-rtn
       (db-call `(db-show ,objects)))
    (> present the > attributes of > objects if-end-rtn
       (db-call
         `(db-show
            (db-project ,objects over ,@attributes))))))


(compile-tree attributes
  (brnchs (> attribute > attributes rtn (cons attribute
                                              attributes))
          (and > attribute          rtn (list attribute))
          (> attribute              rtn (list attribute))))
(compile-tree attribute
  (brnchs (class        rtn 'class)
          (color        rtn 'color)
          (size         rtn 'size)
          (weight       rtn 'weight)
          (position     rtn 'peg)
          (location     rtn 'peg)))


(compile-tree attribute-values
  (brnchs (> attribute-value > attribute-values
             rtn (append attribute-value attribute-values))
          (and > attribute-value rtn attribute-value)
          (> attribute-value rtn attribute-value)))
(compile-tree attribute-value
  (brnchs (large        rtn '(size eql large))
          (medium       rtn '(size eql medium))
          (small        rtn '(size eql small))
          (long         rtn '(size eql long))
          (short        rtn '(size eql short))
          (black        rtn '(color eql black))
          (blue         rtn '(color eql blue))
          (red          rtn '(color eql red))
          (yellow       rtn '(color eql yellow))
          (gray         rtn '(color eql gray))
          (heavy        rtn '(weight eql heavy))
          (light        rtn '(weight eql light))))


(compile-tree objects
  (brnchs (> determiner > objects rtn objects)
          (> attribute-values > object
             rtn `(db-select ,object with ,@attribute-values))
          (> object rtn object)))
(compile-tree determiner
  (brnchs (a) (the)))
(compile-tree object
  (brnchs (saw          rtn 'saws)
          (saws         rtn 'saws)
          (hammer       rtn 'hammers)
          (hammers      rtn 'hammers)
          (wrench       rtn 'wrenches)
          (wrenches     rtn 'wrenches)
          (screwdriver  rtn 'screwdrivers)
          (screwdrivers rtn 'screwdrivers)))


(compile-tree enumerate
  (brnchs (identify)
          (describe)))
(compile-tree present
  (brnchs (show me)
          (what is)
          (what are)
          (give)
          (display)
          (print)
          (present)))
(compile-tree object1 (> objects rtn objects))
(compile-tree object2 (> objects rtn objects))