;;; Code stored as: {turing}<3-lisp.problem-sets>3-lisp-internalizer.3-lisp ;;; {phylum}<3-lisp>course>problem-sets>3-lisp-internalizer.3-lisp ;;;========================================================================== ;;; Simple 3-LISP Expression Internalizer ;;;========================================================================== ;;; ;;; Internalizes 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: ( is the primitive lexical item) ;;; ;;; ::= | | ;;; ;;; ::= "[" * "]" ;;; ::= "(" + ")" ;;; ::= ;;; (INTERNALIZATION string) Builds the 3-LISP internal structure corresponding to string. ;;; ======================== (define INTERNALIZATION (lambda [string] (init-lexan) (letseq [[s (token-list string)] [answer (dynamic-catch (internalize-expression s))]] (if (and (not (= answer $false)) (= (next-token s) 'eot)) answer "Rejected")))) ;;; Ancillary internalize functions: ;;; ;;; All the following internalize functions are responsible for internalizing ;;; 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-INTERNALIZATION immediately upon finding ;;; a grammatical error of any sort, which should 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.). ;;; ;;; All of the procedures return handles to the 3-LISP structure built. ;;; INTERNALIZE-EXPRESSION Attempts to internalize an arbitrary 3-LISP ;;; ====================== expression, returning the corresponding structure. (define INTERNALIZE-EXPRESSION (lambda [s] (select (next-token s) ["[" (internalize-rail s)] ["(" (internalize-pair s)] [$true (internalize-identifier s)]))) ;;; INTERNALIZE-RAIL attempts to internalize a 3-LISP rail expression ;;; ================ (define INTERNALIZE-RAIL (lambda [s] (get-token s) ; skip the open bracket (let [[answer (internalize-exp-list s "]")]] (get-token s) ; skip the close bracket (rcons . answer)))) ;;; INTERNALIZE-PAIR attempts to internalize a 3-LISP pair expression ;;; ================ (define INTERNALIZE-PAIR (lambda [s] (get-token s) ; skip the open parenthesis (let [[answer (internalize-exp-list s ")")]] (get-token s) ; skip the close parenthesis (pcons (first answer) (rcons . (rest answer)))))) ;;; INTERNALIZE-EXP-LIST attempts to internalize 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 INTERNALIZE-EXP-LIST (lambda [s ending-token] (if (= (next-token s) ending-token) [] (cons (internalize-expression s) (internalize-exp-list s ending-token))))) ;;; INTERNALIZE-IDENTIFIER attempts to internalize a 3-LISP identifier ;;; ====================== (define INTERNALIZE-IDENTIFIER (lambda [s] (let [[tok (get-token s)]] (if (member tok ['eot "[" "]" "(" ")"]) (error-in-internalization) (atom-notated tok))))) ;;; ERROR-IN-INTERNALIZATION Signals an error. ;;; ======================== (define ERROR-IN-INTERNALIZATION (lambda [] (dynamic-throw $false)))