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

;;; 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-lex)
      (letseq [[s (token-list string)]
               [answer (get-token s)]    ; get past a bug
               [answer (dynamic-catch (recognize-expression s))]]
         (if (and answer (= (next-token s) 'eot))
             "Accepted"
             "Rejected"))))

;;; Ancillary recognition functions:
;;;
;;;    All the following recognition functions are responsible for
;;;    recognizing just one type of 3-LISP expression.  They use
;;;    GET-TOKEN etc. from the lexical-analyser package, which are set
;;;    up by making a TOKEN-LIST object.  Thus they require a call to TOKEN-LIST
;;;    before running (as is done by RECOGNIZE above).  They all call
;;;    the procedure ERROR-IN-RECOGNITION immediately upon finding a
;;;    syntactic error of any sort, which should not return, as the
;;;    procedures below are not guaranteed to do anything sensible
;;;    about continuing from errors.  ERROR-IN-RECOGNITION simply
;;;    throws control back to a corresponding catch in RECOGNIZE.  See
;;;    DYNAMIC-CATCH and DYNAMIC-THROW below.

;;; 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 tok)]
               [(every-character
                   (lambda [ch] (not (member ch *special-chars*)))
                   tok)
                $true]
               [$true (error-in-recognition tok)]))))

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

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