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


;;;==========================================================================
;;;                   Simple ARITH Expression Recognizer
;;;==========================================================================
;;;
;;; Recognizes ARITH expressions.

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

;;; Assumed grammar:  (<token> is the primitive lexical item)
;;;
;;;     <expression> ::= <numeral> | <complex>
;;; 
;;;     <complex>    ::= "+" "(" <expression> "," <expression> ")"
;;;                      "-" "(" <expression> "," <expression> ")"
;;;                      "*" "(" <expression> "," <expression> ")"
;;;                      "/" "(" <expression> "," <expression> ")"

;;; ARITH-RECOGNIZE  Main recognition routine.  Returns a message
;;; ===============  identifying whether or not the STRING encodes a single
;;;                  well-formed ARITH expression.

(define ARITH-RECOGNIZE
   (lambda [string]
      (if (null (dynamic-catch
                   (arith-recognize-expression (lexical-analysis string))))
          "Accepted"
          "Rejected")))

;;; Ancillary recognition functions:
;;;
;;;    The following procedures call ERROR-IN-RECOGNITION immediately upon
;;;    finding a grammatical error of any sort, which does not return (since
;;;    the procedures below are not designed to do anything sensible about
;;;    continuing from errors), but instead does a DYNAMIC-THROW (q.v.).

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

(define ARITH-RECOGNIZE-EXPRESSION
   (lambda [tail]
      (cond [(member (first tail) ["+" "*" "-" "/"])
             (arith-recognize-args (rest tail))]
            [(numeral-expression (first tail))
             (rest tail)]
            [$true (arith-error-in-recognition)])))

;;; ARITH-RECOGNIZE-ARGS  attempts to recognize an ARITH args expression
;;; ====================

(define ARITH-RECOGNIZE-ARGS
    (lambda [tail]
       (letseq [[tail (arith-recognize-token "(" tail)]
                [tail (arith-recognize-expression tail)]
                [tail (arith-recognize-token "," tail)]
                [tail (arith-recognize-expression tail)]
                [tail (arith-recognize-token ")" tail)]]
          tail)))

(define ARITH-RECOGNIZE-TOKEN
   (lambda [token tail]
      (if (and (not (null tail))
               (= token (first tail)))
          (rest tail)
          (arith-error-in-recognition))))

;;; ARITH-ERROR-IN-RECOGNITION   Signals an error by sending back non-empty sequence.
;;; ==========================

(define ARITH-ERROR-IN-RECOGNITION
   (lambda []
      (dynamic-throw ["something"])))



;;; ========================================================================
;;;   DIFFERENT VERSION USING OBJECTS
;;; ========================================================================

;;; A2-RECOGNIZE  Main recognition routine.  Returns a message
;;; ============  identifying whether or not the STRING encodes a single
;;;               well-formed ARITH expression.

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

;;; Ancillary recognition functions:
;;;
;;;    The following procedures call ERROR-IN-RECOGNITION immediately upon
;;;    finding a grammatical error of any sort, which does not return (since
;;;    the procedures below are not designed to do anything sensible about
;;;    continuing from errors), but instead does a DYNAMIC-THROW (q.v.).

;;; A2-RECOGNIZE-EXPRESSION  Attempts to recognize an arbitrary ARITH
;;; =======================  expression.

(define A2-RECOGNIZE-EXPRESSION
   (lambda [s]
      (cond [(member (next-token s) ["+" "*" "-" "/"])
             (a2-recognize-args s)]
            [(numeral-expression (get-token s)) $true]
            [$true (a2-error-in-recognition)])))

;;; A2-RECOGNIZE-ARGS   Attempts to recognize an ARITH args expression
;;; =================

(define A2-RECOGNIZE-ARGS
   (lambda [s]
      (get-token s)                          ; skip the operator
      (a2-recognize-token "(" s)
      (a2-recognize-expression s)
      (a2-recognize-token "," s)
      (a2-recognize-expression s)
      (a2-recognize-token ")" s)))

;;; A2-RECOGNIZE-TOKEN    Ensures that the next token in s is token
;;; ==================

(define A2-RECOGNIZE-TOKEN
   (lambda [token s]
      (if (not (= token (get-token s)))
          (a2-error-in-recognition)
          $true)))

;;; A2-ERROR-IN-RECOGNITION   Signals an error by sending back $false.
;;; =======================

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