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


;;;==========================================================================
;;;                   Simple 3-LISP Expression Recognizer
;;;==========================================================================
;;;
;;; Recognizes 3-LISP expressions including rails, pairs and simple symbols.
;;; Does not handle numerals, handles, strings, or booleans.

;;; Built on top of the 3-LISP Lexical Analyser
;;; -------------------------------------------

;;; Assumed grammar:  (<token> is the primitive lexical item)
;;;
;;;     <expression> ::= <rail-exp> | <pair-exp> | <identifier>
;;; 
;;;     <rail-exp>   ::= "[" <expression>* "]"
;;;     <pair-exp>   ::= "(" <expression>+ ")"
;;;     <identifier> ::= <alphanumeric token>

;;; RECOGNIZE  Main recognition routine.  Returns a message
;;; =========  identifying whether or not the STRING encodes a single
;;;            well-formed 3-LISP expression.  This version ignores
;;;            the information signaled by an error.

(define RECOGNIZE
   (lambda [string]
      (init-lexan)
      (letseq [[s (token-list string)]
               [answer (dynamic-catch (recognize-expression s))]]
         (if (and answer (= (next-token s) 'eot))
             "Accepted"
             "Rejected"))))


;;; Ancillary recognition functions:
;;;
;;;    All the following read functions are responsible for reading just one
;;;    type of 3-LISP expression.  They use GET-TOKEN and other such methods,
;;;    defined in the lexical-analyser package, on TOKEN-LIST objects.  They
;;;    call the procedure ERROR-IN-RECOGNITION immediately upon finding
;;;    a grammatical error of any sort, which does not return (the procedures
;;;    below are not designed to do anything sensible about continuing from
;;;    errors), but instead should error or do a DYNAMIC-THROW (q.v.).


;;; RECOGNIZE-EXPRESSION  Attempts to recognize an arbitrary 3-LISP
;;; ====================  expression.

(define RECOGNIZE-EXPRESSION
   (lambda [s]
      (select (next-token s)
         ["[" (recognize-rail s)]
         ["(" (recognize-pair s)]
         [$true (recognize-identifier s)])))


;;; RECOGNIZE-RAIL  attempts to recognize a 3-LISP rail expression
;;; ==============

(define RECOGNIZE-RAIL
   (lambda [s]
      (get-token s)                      ; skip the open bracket
      (recognize-exp-list s "]")
      (get-token s)                      ; skip the close bracket   
      $true))


;;; RECOGNIZE-EXP-LIST  attempts to recognize a list of 3-LISP expressions
;;; ==================  delimited by (but not including) the token
;;;                     ENDING-TOKEN.

(define RECOGNIZE-EXP-LIST
   (lambda [s ending-token]
      (if (= (next-token s) ending-token)
          $true
          (begin (recognize-expression s)
                 (recognize-exp-list s ending-token)))))


;;; RECOGNIZE-PAIR  attempts to recognize a 3-LISP pair expression
;;; ==============

(define RECOGNIZE-PAIR
   (lambda [s]
      (get-token s)                      ; skip the open parenthesis
      (recognize-expression s)           ; there must be at least one exp. 
      (recognize-exp-list s ")")
      (get-token s)                      ; skip the close parenthesis
      $true))


;;; RECOGNIZE-IDENTIFIER  attempts to recognize a 3-LISP identifier
;;; ====================

(define RECOGNIZE-IDENTIFIER
   (lambda [s]
      (let [[tok (get-token s)]]
         (cond [(member tok ['eot "[" "]" "(" ")"])
                (error-in-recognition)]
               [(every-character
                   (lambda [ch] (not (member ch *special-chars*)))
                   tok)
                $true]
               [$true (error-in-recognition)]))))

;;; ERROR-IN-RECOGNITION   Signals an error.
;;; ====================

(define ERROR-IN-RECOGNITION
   (lambda []
      (dynamic-throw $false)))