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


;;; =======================================================================
;;; 
;;;         RECURSIVE DESCENT RECOGNIZER
;;;
;;; =======================================================================


;;; Grammars are to be represented as a sequence of rules, where each rule is
;;; a sequence of a left-hand side and one or more right-hand side symbols.
;;; For example:
;;; 
;;;     (set *sample* [['s 'np 'vp]
;;;                    ['vp 'v 'np]
;;;                    ['vp 'v]
;;;                    ['v "slept"]
;;;                    ['v "loved"]
;;;                    ['v "wielded"]
;;;                    ['np "arthur"]
;;;                    ['np "gwen"]
;;;                    ['np "excalibur"]])
;;; 
;;; then:  (recognize "arthur slept" 's *sample*)              =>  "accepted"
;;;        (recognize "arthur wielded excalibur" 's *sample*)  =>  "accepted"
;;;        (recognize "arthur gwen" 's *sample*)               =>  "rejected"


(define RECOGNIZE-1
   (lambda [expression start-symbol grammar]
      (if (recognize-frontier-1 (lexical-analysis expression)
                                [start-symbol]
                                grammar)
          "accepted"
          "rejected")))

(define RECOGNIZE-FRONTIER-1
   (lambda [tokens frontier grammar]
      (cond [(null frontier) (null tokens)]
            [(terminal (first frontier))
             (and (not (null tokens))
                  (match (first frontier) (first tokens))
                  (recognize-frontier-1 (rest tokens) (rest frontier) grammar))]
            [(nonterminal (first frontier))
             (some (lambda [rhs]
                      (recognize-frontier-1 tokens
                                            (append rhs (rest frontier))
                                            grammar))
                   (rhsides (first frontier) grammar))])))

(define TERMINAL 
   (lambda [symbol]
      (or (= symbol 'identifier-expression)
          (= symbol 'numeral-expression)
          (string symbol))))

(define NONTERMINAL (compose not terminal))

(define MATCH 
   (lambda [nonterm token]
      (cond [(= nonterm 'identifier-expression) (identifier-expression token)]
            [(= nonterm 'numeral-expression) (numeral-expression token)]
            [$true (= nonterm token)])))

(define RHSIDES
   (lambda [nonterm grammar]
      (filtered-map rest
                    (lambda [rule] (= nonterm (first rule)))
                    grammar)))

;;; ======================================================================
;;;          ANOTHER VERSION
;;; ======================================================================


(define RECOGNIZE-2
   (lambda [expression start-symbol grammar]
      (if (some null
                (recognize-symbol-2 (lexical-analysis expression)
                                    start-symbol
                                    grammar))
          "accepted"
          "rejected")))

(define RECOGNIZE-SYMBOL-2
   (lambda [tokens symbol grammar]
      (cond [(null tokens) (nothing)]
            [(match symbol (first tokens))
             (singleton (rest tokens))]
            [$t (collect (lambda [rhs]
                            (recognize-frontier-2 tokens rhs grammar))
                         (rhsides symbol grammar))])))

(define RECOGNIZE-FRONTIER-2
   (lambda [tokens frontier grammar]
      (cond [(null frontier) (singleton tokens)]
            [(null tokens) (nothing)]
            [$t (collect (lambda [fragment]
                            (recognize-frontier-2 fragment (rest frontier) grammar))
                         (recognize-symbol-2 tokens (first frontier) grammar))])))

;;; ======================================================================
;;;          YET A THIRD VERSION  (even more compact)
;;; ======================================================================

(define RECOGNIZE-3
   (lambda [expression start-symbol grammar]
      (if (some null
                (recognize-frontier-3 (lexical-analysis expression)
                                      [start-symbol]
                                      grammar))
          "accepted"
          "rejected")))


(define RECOGNIZE-FRONTIER-3
   (lambda [tokens frontier grammar]
      (cond [(null frontier) (singleton tokens)]
            [(null tokens) (nothing)]
            [$t (collect (lambda [fragment]
                            (recognize-frontier-3 fragment (rest frontier) grammar))
                         (if (match (first frontier) (first tokens))
                             (singleton (rest tokens))
                             (collect (lambda [rhs]
                                         (recognize-frontier-3 tokens rhs grammar))
                                      (rhsides (first frontier) grammar))))])))


;;; ======================================================================
;;;          TESTS
;;; ======================================================================

(set *3g*
   [['exp 'identifier-expression]
    ['exp "(" 'exp "." 'exp ")"]
    ['exp "[" 'exps "]"]
    ['exp "[" "]"]
    ['exps 'exp 'exps]
    ['exps 'exp]])

(==> (recognize-1 "" 'exp *3g*) "rejected")
(==> (recognize-1 "a" 'exp *3g*) "accepted")
(==> (recognize-1 "(a.b)" 'exp *3g*) "accepted")
(==> (recognize-1 "(a b )" 'exp *3g*) "rejected")
(==> (recognize-1 "[]" 'exp *3g*) "accepted")
(==> (recognize-1 "[a (b . b) a]" 'exp *3g*) "accepted")

(set *3-epsilon*
   [['exp 'identifier-expression]
    ['exp "(" 'exp "." 'exp ")"]
    ['exp "[" 'exps "]"]
    ['exps 'exp 'exps]
    ['exps]])