;;;==========================================================================
;;;                     Simple 3-LISP Expression Reader ;;;==========================================================================
;;;
;;; Reads 3-LISP expressions including rails, pairs and simple symbols.
;;; Does not handle numerals, handles, strings, or booleans.
;;; Builds internal structure for the expression.

;;; Assumed grammar:  (<token> is the primitive lexical item)
;;;
;;;     <expression> ::= <rail> | <pair> | <symbol>
;;;     <rail> ::= "[" <expression>* "]"
;;;     <pair> ::= "(" <expression>* ")"
;;;     <symbol> ::= <token>

;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;;; NOTE:  SHOULD BE MODIFIED TO CORRESPOND TO THE 3-LISP EXPRESSION RECOGNIZER.
;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

;;; READ-3-LISP  reads from STRING, building the corresponding 3-LISP
;;; ===========  internal structure.

(define read-3-lisp
   (lambda [string]
      (init-lex string)      
      (let [[answer (catch recognition-error
                           (begin (define error-in-recognition
                                     (lambda [] 
                                        (recognition-error $false)))
                                  (read-expression)))]]
         (if (and (not (= answer $false))
                  (= (next-token) 'eot))
             answer
             $false))))


;;; Ancillary read functions:
;;;
;;;    All the following read functions are responsible for
;;;    reading just one type of 3-LISP expression.  They use
;;;    GET-TOKEN etc. from the lexical-analyser package, which are set
;;;    up by a call to INIT-LEX.  Thus they require a call to INIT-LEX 
;;;    before running (as is done by RECOGNIZE above).  They also assume
;;;    that the procedure ERROR-IN-RECOGNITION is bound.  This is
;;;    called immediately upon finding a syntactic error of any sort.
;;;    It should not return, as the procedures below are not guaranteed to 
;;;    do anything sensible about continuing from errors.  Thus the logical
;;;    thing to do is to have ERROR-IN-RECOGNITION bound to some THROW
;;;    procedure (see CATCH in the 3-LISP reference manual) as is done in 
;;;    RECOGNIZE above.
;;;
;;;    All of the procedures return handles to the 3-LISP structure built.


;;; READ-EXPRESSION  attempts to read an arbitrary 3-LISP
;;; ===============  expression, returning the corresponding structure.

(define read-expression
   (lambda []
      (select (next-token)
         ["[" (read-rail)]
         ["(" (read-pair)]
         [$true (read-symbol)])))


;;; READ-RAIL  attempts to read a 3-LISP rail expression
;;; =========

(define read-rail
   (lambda []
      (get-token)                        ; skip the open bracket
      (let [[answer (read-exp-list "]")]]
         (get-token)                     ; skip the close bracket   
         (rcons . answer))))


;;; READ-EXP-LIST  attempts to read a list of 3-LISP expressions
;;; =============  delimited by (but not including) the token
;;;                ENDING-TOKEN, returning a rail of handles
;;; designating the structures notated by the various elements in the
;;; list read. (Whew.)

(define read-exp-list
   (lambda [ending-token]
      (if (= (next-token) ending-token)
          []
          (cons (read-expression)
                (read-exp-list ending-token)))))


;;; READ-PAIR  attempts to read a 3-LISP pair expression
;;; =========

(define read-pair
   (lambda []
      (get-token)                        ; skip the open parenthesis
      (let [[answer (read-exp-list ")")]]
         (get-token)                     ; skip the close parenthesis
         (pcons (first answer) (rcons . (rest answer))))))


;;; READ-SYMBOL  attempts to read a  3-LISP symbol
;;; ===========

(define read-symbol
   (lambda []
      (let [[tok (get-token)]]
         (if (member tok ['eot "[" "]" "(" ")"])
             (error-in-recognition)
             (atom-notated tok)))))