diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 6862a97..6de62c1 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -2625,6 +2625,7 @@ It is pretty much just a translation of DEF-IS-REV @ \chapter{PARSE forms} +\section{The original meta specification} \begin{verbatim} % Scratchpad II Boot Language Grammar, Common Lisp Version % IBM Thomas J. Watson Research Center @@ -2874,6 +2875,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; .FIN ; \end{verbatim} +\section{The PARSE code} \defun{PARSE-NewExpr}{PARSE-NewExpr} \calls{PARSE-NewExpr}{match-string} @@ -3583,7 +3585,6 @@ IteratorTail: ('repeat' ! / Iterator*) ; @ \defun{PARSE-FloatBase}{PARSE-FloatBase} -\calls{PARSE-FloatBase}{integerp} \calls{PARSE-FloatBase}{current-symbol} \calls{PARSE-FloatBase}{char-eq} \calls{PARSE-FloatBase}{current-char} @@ -3592,7 +3593,6 @@ IteratorTail: ('repeat' ! / Iterator*) ; \calls{PARSE-FloatBase}{PARSE-IntegerTok} \calls{PARSE-FloatBase}{must} \calls{PARSE-FloatBase}{PARSE-FloatBasePart} -\calls{PARSE-FloatBase}{char-upcase} \calls{PARSE-FloatBase}{PARSE-IntegerTok} \calls{PARSE-FloatBase}{push-reduction} \calls{PARSE-FloatBase}{digitp} @@ -3813,6 +3813,137 @@ IteratorTail: ('repeat' ! / Iterator*) ; @ +\defun{PARSE-Sexpr}{PARSE-Sexpr} +\calls{PARSE-Sexpr}{PARSE-Sexpr1} +<>= +(defun |PARSE-Sexpr| () + (and (action (advance-token)) (|PARSE-Sexpr1|))) + +@ + +\defun{PARSE-Sexpr1}{PARSE-Sexpr1} +\calls{PARSE-Sexpr1}{PARSE-AnyId} +\calls{PARSE-Sexpr1}{optional} +\calls{PARSE-Sexpr1}{PARSE-NBGliphTok} +\calls{PARSE-Sexpr1}{must} +\calls{PARSE-Sexpr1}{PARSE-Sexpr1} +\calls{PARSE-Sexpr1}{action} +\calls{PARSE-Sexpr1}{pop-stack-2} +\calls{PARSE-Sexpr1}{nth-stack} +\calls{PARSE-Sexpr1}{match-advance-string} +\calls{PARSE-Sexpr1}{push-reduction} +\calls{PARSE-Sexpr1}{PARSE-IntegerTok} +\calls{PARSE-Sexpr1}{pop-stack-1} +\calls{PARSE-Sexpr1}{PARSE-String} +\calls{PARSE-Sexpr1}{bang} +\calls{PARSE-Sexpr1}{star} +\calls{PARSE-Sexpr1}{PARSE-GliphTok} +<>= +(defun |PARSE-Sexpr1| () + (or (and (|PARSE-AnyId|) + (optional + (and (|PARSE-NBGliphTok| '=) (must (|PARSE-Sexpr1|)) + (action (setq lablasoc + (cons (cons (pop-stack-2) + (nth-stack 1)) + lablasoc)))))) + (and (match-advance-string "'") (must (|PARSE-Sexpr1|)) + (push-reduction '|PARSE-Sexpr1| + (list 'quote (pop-stack-1)))) + (|PARSE-IntegerTok|) + (and (match-advance-string "-") (must (|PARSE-IntegerTok|)) + (push-reduction '|PARSE-Sexpr1| (- (pop-stack-1)))) + (|PARSE-String|) + (and (match-advance-string "<") + (bang fil_test (optional (star repeator (|PARSE-Sexpr1|)))) + (must (match-advance-string ">")) + (push-reduction '|PARSE-Sexpr1| (list2vec (pop-stack-1)))) + (and (match-advance-string "(") + (bang fil_test + (optional + (and (star repeator (|PARSE-Sexpr1|)) + (optional + (and (|PARSE-GliphTok| '|.|) + (must (|PARSE-Sexpr1|)) + (push-reduction '|PARSE-Sexpr1| + (nconc (pop-stack-2) (pop-stack-1)))))))) + (must (match-advance-string ")"))))) + +@ + +\section{The PARSE support routines} +\subsection{Applying metagrammatical elements of a production (e.g., Star).} +\begin{itemize} +\item {\bf must} means that if it is not present in the token stream, +it is a syntax error. +\item {\bf optional} means that if it is present in the token stream, +that is a good thing, otherwise don't worry (like [ foo ] in BNF notation). +\item {\bf action} is something we do as a consequence of successful +parsing; it is inserted at the end of the conjunction of requirements +for a successful parse, and so should return T. +\item {\bf sequence} consists of a head, which if recognized implies that the +tail must follow. Following tail are actions, which +are performed upon recognizing the head and tail. +\end{itemize} +\defmacro{Bang} +If the execution of prod does not result in an increase in the size of +the stack, then stack a NIL. Return the value of prod. +<>= +(defmacro Bang (lab prod) + `(progn + (setf (stack-updated reduce-stack) nil) + (let* ((prodvalue ,prod) (updated (stack-updated reduce-stack))) + (unless updated (push-reduction ',lab nil)) + prodvalue))) + +@ + +\defmacro{must} +<>= +(defmacro must (dothis &optional (this-is nil) (in-rule nil)) + `(or ,dothis (meta-syntax-error ,this-is ,in-rule))) + +@ + +\defun{action}{action} +<>= +(defun action (dothis) (or dothis t)) + +@ + +\defun{optional}{optional} +<>= +(defun optional (dothis) (or dothis t)) + +@ + +\defmacro{star} +Succeeds if there are one or more of PROD, stacking as one unit +the sub-reductions of PROD and labelling them with LAB. +E.G., {\tt (Star IDs (parse-id))} with A B C will stack (3 IDs (A B C)), +where (parse-id) would stack (1 ID (A)) when applied once. +\calls{star}{stack-size} +\calls{star}{push-reduction} +\calls{star}{push} +\calls{star}{pop-stack-1} +<>= +(defmacro star (lab prod) + `(prog ((oldstacksize (stack-size reduce-stack))) + (if (not ,prod) (return nil)) +loop + (if (not ,prod) + (let* ((newstacksize (stack-size reduce-stack)) + (number-of-new-reductions (- newstacksize oldstacksize))) + (if (> number-of-new-reductions 0) + (return (do ((i 0 (1+ i)) (accum nil)) + ((= i number-of-new-reductions) + (push-reduction ',lab accum) + (return t)) + (push (pop-stack-1) accum))) + (return t))) + (go loop)))) + +@ \chapter{The Compiler} \section{Compiling EQ.spad} @@ -6872,6 +7003,8 @@ if \verb|$InteractiveMode| then use a null outputstream <> + +<> <> <> <> @@ -6971,6 +7104,8 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> +<> + <> <> <> @@ -7011,6 +7146,8 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> +<> <> <> <> diff --git a/changelog b/changelog index db2b2a9..e01e12a 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20101016 tpd src/axiom-website/patches.html 20101016.04.tpd.patch +20101016 tpd src/interp/parsing.lisp treeshake compiler +20101016 tpd books/bookvol9 treeshake compiler 20101016 tpd src/axiom-website/patches.html 20101016.03.tpd.patch 20101016 tpd src/interp/parsing.lisp treeshake compiler 20101016 tpd books/bookvol9 treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 660acf0..fa08af2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3224,5 +3224,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101016.03.tpd.patch books/bookvol9 treeshake compiler
+20101016.04.tpd.patch +books/bookvol9 treeshake compiler
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 553f067..4c90552 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -20,7 +20,34 @@ translator writing system. Metalanguage is described in META/LISP, R.D. Jenks, Tech Report, IBM T.J. Watson Research Center, 1969. Familiarity with this document is assumed. +<<*>>= +(defmacro star (lab prod) + `(prog ((oldstacksize (stack-size reduce-stack))) + (if (not ,prod) (return nil)) +loop + (if (not ,prod) + (let* ((newstacksize (stack-size reduce-stack)) + (number-of-new-reductions (- newstacksize oldstacksize))) + (if (> number-of-new-reductions 0) + (return (do ((i 0 (1+ i)) (accum nil)) + ((= i number-of-new-reductions) + (push-reduction ',lab accum) + (return t)) + (push (pop-stack-1) accum))) + (return t))) + (go loop)))) + +(defmacro must (dothis &optional (this-is nil) (in-rule nil)) + `(or ,dothis (meta-syntax-error ,this-is ,in-rule))) +(defmacro Bang (lab prod) + `(progn + (setf (stack-updated reduce-stack) nil) + (let* ((prodvalue ,prod) (updated (stack-updated reduce-stack))) + (unless updated (push-reduction ',lab nil)) + prodvalue))) + +@ \section{Current I/O Stream definition} <<*>>= (defun IOStreams-Show () @@ -217,57 +244,8 @@ Familiarity with this document is assumed. `(reduction-value (nth (1- ,x) (stack-store Reduce-Stack)))) @ -\subsection{Applying metagrammatical elements of a production (e.g., Star).} -\begin{itemize} -\item {\bf Must} means that if it is not present in the token stream, -it is a syntax error. -\item {\bf Optional} means that if it is present in the token stream, -that is a good thing, otherwise don't worry (like [ foo ] in BNF notation). -\item {\bf Action} is something we do as a consequence of successful -parsing; it is inserted at the end of the conjunction of requirements -for a successful parse, and so should return T. -\item {\bf sequence} consists of a head, which if recognized implies that the -tail must follow. Following tail are actions, which -are performed upon recognizing the head and tail. -\end{itemize} <<*>>= -(defmacro Star (lab prod) - "Succeeds if there are one or more of PROD, stacking as one unit - the sub-reductions of PROD and labelling them with LAB. - E.G., (Star IDs (parse-id)) with A B C will stack (3 IDs (A B C)), - where (parse-id) would stack (1 ID (A)) when applied once." - `(prog ((oldstacksize (stack-size reduce-stack))) - (if (not ,prod) (return nil)) -loop - (if (not ,prod) - (let* ((newstacksize (stack-size reduce-stack)) - (number-of-new-reductions (- newstacksize oldstacksize))) - (if (> number-of-new-reductions 0) - (return (do ((i 0 (1+ i)) (accum nil)) - ((= i number-of-new-reductions) - (Push-Reduction ',lab accum) - (return t)) - (push (pop-stack-1) accum))) - (return t))) - (go loop)))) - -(defmacro Bang (lab prod) - "If the execution of prod does not result in an increase in the size of - the stack, then stack a NIL. Return the value of prod." - `(progn - (setf (stack-updated reduce-stack) nil) - (let* ((prodvalue ,prod) (updated (stack-updated reduce-stack))) - (unless updated (push-reduction ',lab nil)) - prodvalue))) - -(defmacro must (dothis &optional (this-is nil) (in-rule nil)) - `(or ,dothis (meta-syntax-error ,this-is ,in-rule))) - -(defun Optional (dothis) (or dothis t)) - -(defun action (dothis) (or dothis t)) - (defmacro sequence (subrules &optional (actions nil)) `(and ,(pop subrules) . ,(append (mapcar #'(lambda (x) (list 'must x)) subrules) @@ -1810,43 +1788,6 @@ except that elements are separated by commas." (trace |PARSE-FloatTok|) -(DEFUN |PARSE-Sexpr| () - (AND (ACTION (ADVANCE-TOKEN)) (|PARSE-Sexpr1|))) -(trace |PARSE-Sexpr|) - - -(DEFUN |PARSE-Sexpr1| () - (OR (AND (|PARSE-AnyId|) - (OPTIONAL - (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|)) - (ACTION (SETQ LABLASOC - (CONS (CONS (POP-STACK-2) - (NTH-STACK 1)) - LABLASOC)))))) - (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|)) - (PUSH-REDUCTION '|PARSE-Sexpr1| - (CONS 'QUOTE (CONS (POP-STACK-1) NIL)))) - (|PARSE-IntegerTok|) - (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|)) - (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1)))) - (|PARSE-String|) - (AND (MATCH-ADVANCE-STRING "<") - (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|)))) - (MUST (MATCH-ADVANCE-STRING ">")) - (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1)))) - (AND (MATCH-ADVANCE-STRING "(") - (BANG FIL_TEST - (OPTIONAL - (AND (STAR REPEATOR (|PARSE-Sexpr1|)) - (OPTIONAL - (AND (|PARSE-GliphTok| '|.|) - (MUST (|PARSE-Sexpr1|)) - (PUSH-REDUCTION '|PARSE-Sexpr1| - (NCONC (POP-STACK-2) (POP-STACK-1)))))))) - (MUST (MATCH-ADVANCE-STRING ")"))))) -(trace |PARSE-Sexpr1|) - - (DEFUN |PARSE-NBGliphTok| (|tok|) (DECLARE (SPECIAL |tok|)) (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) NONBLANK