;;; Code stored as:  {turing}<3-lisp.problem-sets>general-transducer.3-lisp
;;;                  {phylum}<3-lisp>course>problem-sets>general-transducer.3-lisp


;;; =======================================================================
;;; 
;;;         RECURSIVE DESCENT TRANSDUCER  with  AUGMENTS
;;;
;;; =======================================================================

;;; Modified version takes functional augments and applies them to constituents
;;; as they are found.

;;; An analysis is a rail of the form: [transduction tail]

;;; A transduction is a function to be applied to the transductions
;;; of the remaining constituents to be found, or (in the base case)
;;; any 3-LISP entity.  The transductions are obtained from the grammar.

;;; The grammar format is a rail of rules, each rule of the form:
;;; 
;;;        [lhs transduction rhs]

(define TRANS
   (lambda [string start-symbol grammar]
      (let [[good-transductions
               (filtered-map first
                             (compose null second)
                             (trans-symbol id
                                           (lexical-analysis string)
                                           start-symbol
                                           grammar))]]
          (if (null good-transductions)
              "rejected"
              good-transductions))))

(define TRANS-SYMBOL 
  (lambda [transer tail symbol grammar]
    (if (match symbol (first tail))                      ; If direct match, single
        (singleton [(transer (first tail)) (rest tail)]) ; good transduction
        (map (lambda [analysis]
                [(transer (first analysis))
                 (second analysis)])
             (collect (lambda [rhs]                  ; otherwise trans analyses
                         (trans-frontier (first rhs) ; obtainable by the recursive
                                         tail        ; parsing calls
                                         (rest rhs)
                                         grammar))
                      (rhsides symbol grammar))))))

(define TRANS-FRONTIER
   (lambda [transer tail frontier grammar]
      (cond [(null frontier) (singleton [transer tail])]
            [(null tail) (nothing)]
            [$true (collect (lambda [analysis]
                               (trans-frontier (first analysis)
                                               (second analysis)
                                               (rest frontier)
                                               grammar))
                            (trans-symbol transer tail (first frontier) grammar))])))