diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 6de62c1..81cabc4 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -2589,6 +2589,40 @@ It is pretty much just a translation of DEF-IS-REV @ +\defun{def-addlet}{def-addlet} +\calls{def-addlet}{mkprogn} +\calls{def-addlet}{def-let} +\calls{def-addlet}{compfluidize} +\usesdollar{def-addlet}{body} +<>= +(defun def-addlet (x) + (declare (special $body)) + (if (atom x) + (if (stringp x) `(quote ,(intern x)) x) + (let ((g (gensym))) + (setq $body (mkprogn (list (def-let (compfluidize x) g) $body))) + g))) + +@ + +\defun{def-inner}{def-inner} +\calls{def-inner}{def-insert-let} +\calls{def-inner}{def-stringtoquote} +\calls{def-inner}{sublis} +\calls{def-inner}{comp} +\usesdollar{def-inner}{body} +\usesdollar{def-inner}{OpAssoc} +\usesdollar{def-inner}{op} +<>= +(defun def-inner (form signature $body) + "Same as DEF but assumes body has already been DEFTRANned" + (declare (special $body)) + (let ($OpAssoc ($op (first form)) (argl (rest form))) + (declare (special $OpAssoc $op)) + (let* ((argl (def-insert-let argl)) + (arglp (def-stringtoquote argl))) + (comp (sublis $opassoc `((,$op (lam ,arglp ,$body)))))))) + \defun{hackforis}{hackforis} \calls{hackforis}{hackforis1} <>= @@ -2626,6 +2660,15 @@ It is pretty much just a translation of DEF-IS-REV \chapter{PARSE forms} \section{The original meta specification} +This package provides routines to support the Metalanguage +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. + +Note that META/LISP and the meta parser/generator were removed from Axiom. +This information is only for documentation purposes. + \begin{verbatim} % Scratchpad II Boot Language Grammar, Common Lisp Version % IBM Thomas J. Watson Research Center @@ -2636,11 +2679,11 @@ It is pretty much just a translation of DEF-IS-REV .META(New NewExpr Process) .PACKAGE 'BOOT' -.DECLARE(tmptok TOK ParseMode DEFINITION_NAME LABLASOC) +.DECLARE(tmptok TOK ParseMode DEFINITION-NAME LABLASOC) .PREFIX 'PARSE-' NewExpr: =')' .(processSynonyms) Command - / .(SETQ DEFINITION_NAME (CURRENT-SYMBOL)) Statement ; + / .(SETQ DEFINITION-NAME (CURRENT-SYMBOL)) Statement ; Command: ')' SpecialKeyWord SpecialCommand +() ; @@ -2877,6 +2920,35 @@ IteratorTail: ('repeat' ! / Iterator*) ; \end{verbatim} \section{The PARSE code} +\defvar{tmptok} +<>= +(defvar |tmptok| nil) + +@ + +\defvar{tok} +<>= +(defvar tok nil) + +@ + +\defvar{ParseMode} +<>= +(defvar |ParseMode| nil) + +@ + +\defvar{definition-name} +<>= +(defvar definition-name nil) + +@ + +\defvar{lablasoc} +<>= +(defvar lablasoc nil) + +@ \defun{PARSE-NewExpr}{PARSE-NewExpr} \calls{PARSE-NewExpr}{match-string} \calls{PARSE-NewExpr}{action} @@ -2889,7 +2961,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (defun |PARSE-NewExpr| () (or (and (match-string ")") (action (|processSynonyms|)) (must (|PARSE-Command|))) - (and (action (setq definition_name (current-symbol))) + (and (action (setq definition-name (current-symbol))) (|PARSE-Statement|)))) @ @@ -2951,7 +3023,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (or (match-advance-string "?") (|PARSE-Expression|)))) (push-reduction '|PARSE-SpecialCommand| - (cons '|show| (cons (pop-stack-1) nil))) + (list '|show| (pop-stack-1))) (must (|PARSE-CommandTail|))) (and (member (current-symbol) |$noParseCommands|) (action (funcall (current-symbol)))) @@ -3089,7 +3161,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (defun |PARSE-InfixWith| () (and (|PARSE-With|) (push-reduction '|PARSE-InfixWith| - (cons '|Join| (cons (pop-stack-2) (cons (pop-stack-1) nil)))))) + (list '|Join| (pop-stack-2) (pop-stack-1))))) @ @@ -3323,7 +3395,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; (action (advance-token)) (optional (|PARSE-TokTail|)) (must (|PARSE-Expression|)) (push-reduction '|PARSE-Prefix| - (cons (pop-stack-2) (cons (pop-stack-1) nil))))) + (list (pop-stack-2) (pop-stack-1))))) @ @@ -3485,6 +3557,7 @@ IteratorTail: ('repeat' ! / Iterator*) ; \usesdollar{PARSE-Selector}{boot} <>= (defun |PARSE-Selector| () + (declare (special $boot)) (or (and nonblank (eq (current-symbol) '|.|) (char-ne (current-char) '| |) (match-advance-string ".") (must (|PARSE-PrimaryNoFloat|)) @@ -3871,6 +3944,380 @@ IteratorTail: ('repeat' ! / Iterator*) ; @ +\defun{PARSE-NBGliphTok}{PARSE-NBGliphTok} +\calls{PARSE-NBGliphTok}{match-current-token} +\calls{PARSE-NBGliphTok}{action} +\calls{PARSE-NBGliphTok}{advance-token} +\uses{PARSE-NBGliphTok}{tok} +<>= +(defun |PARSE-NBGliphTok| (|tok|) + (declare (special |tok|)) + (and (match-current-token 'gliph |tok|) nonblank (action (advance-token)))) + +@ + +\defun{PARSE-GliphTok}{PARSE-GliphTok} +\calls{PARSE-GliphTok}{match-current-token} +\calls{PARSE-GliphTok}{action} +\calls{PARSE-GliphTok}{advance-token} +\uses{PARSE-GliphTok}{tok} +<>= +(defun |PARSE-GliphTok| (|tok|) + (declare (special |tok|)) + (and (match-current-token 'gliph |tok|) (action (advance-token)))) + +@ + +\defun{PARSE-AnyId}{PARSE-AnyId} +\calls{PARSE-AnyId}{parse-identifier} +\calls{PARSE-AnyId}{match-string} +\calls{PARSE-AnyId}{push-reduction} +\calls{PARSE-AnyId}{current-symbol} +\calls{PARSE-AnyId}{action} +\calls{PARSE-AnyId}{advance-token} +\calls{PARSE-AnyId}{parse-keyword} +<>= +(defun |PARSE-AnyId| () + (or (parse-identifier) + (or (and (match-string "$") + (push-reduction '|PARSE-AnyId| (current-symbol)) + (action (advance-token))) + (parse-keyword)))) + +@ + +\defun{PARSE-Sequence}{PARSE-Sequence} +\calls{PARSE-Sequence}{PARSE-OpenBracket} +\calls{PARSE-Sequence}{must} +\calls{PARSE-Sequence}{PARSE-Sequence1} +\calls{PARSE-Sequence}{match-advance-string} +\calls{PARSE-Sequence}{PARSE-OpenBrace} +\calls{PARSE-Sequence}{push-reduction} +\calls{PARSE-Sequence}{pop-stack-1} +<>= +(defun |PARSE-Sequence| () + (or (and (|PARSE-OpenBracket|) (must (|PARSE-Sequence1|)) + (must (match-advance-string "]"))) + (and (|PARSE-OpenBrace|) (must (|PARSE-Sequence1|)) + (must (match-advance-string "}")) + (push-reduction '|PARSE-Sequence| + (list '|brace| (pop-stack-1)))))) + +@ + +\defun{PARSE-Sequence1}{PARSE-Sequence1} +\calls{PARSE-Sequence1}{PARSE-Expression} +\calls{PARSE-Sequence1}{push-reduction} +\calls{PARSE-Sequence1}{pop-stack-2} +\calls{PARSE-Sequence1}{pop-stack-1} +\calls{PARSE-Sequence1}{optional} +\calls{PARSE-Sequence1}{PARSE-IteratorTail} +<>= +(defun |PARSE-Sequence1| () + (and (or (and (|PARSE-Expression|) + (push-reduction '|PARSE-Sequence1| + (list (pop-stack-2) (pop-stack-1)))) + (push-reduction '|PARSE-Sequence1| (list (pop-stack-1)))) + (optional + (and (|PARSE-IteratorTail|) + (push-reduction '|PARSE-Sequence1| + (cons 'collect + (append (pop-stack-1) + (list (pop-stack-1))))))))) + +@ + +\defun{PARSE-OpenBracket}{PARSE-OpenBracket} +\calls{PARSE-OpenBracket}{getToken} +\calls{PARSE-OpenBracket}{current-symbol} +\calls{PARSE-OpenBracket}{eqcar} +\calls{PARSE-OpenBracket}{push-reduction} +\calls{PARSE-OpenBracket}{action} +\calls{PARSE-OpenBracket}{advance-token} +<>= +(defun |PARSE-OpenBracket| () + (let (g1) + (and (eq (|getToken| (setq g1 (current-symbol))) '[) + (must (or (and (eqcar g1 '|elt|) + (push-reduction '|PARSE-OpenBracket| + (list '|elt| (second g1) '|construct|))) + (push-reduction '|PARSE-OpenBracket| '|construct|))) + (action (advance-token)))))) + +@ + +\defun{PARSE-OpenBrace}{PARSE-OpenBrace} +\calls{PARSE-OpenBrace}{getToken} +\calls{PARSE-OpenBrace}{current-symbol} +\calls{PARSE-OpenBrace}{eqcar} +\calls{PARSE-OpenBrace}{push-reduction} +\calls{PARSE-OpenBrace}{action} +\calls{PARSE-OpenBrace}{advance-token} +<>= +(defun |PARSE-OpenBrace| () + (let (g1) + (and (eq (|getToken| (setq g1 (current-symbol))) '{) + (must (or (and (eqcar g1 '|elt|) + (push-reduction '|PARSE-OpenBrace| + (list '|elt| (second g1) '|brace|))) + (push-reduction '|PARSE-OpenBrace| '|construct|))) + (action (advance-token)))))) + +@ + +\defun{PARSE-IteratorTail}{PARSE-IteratorTail} +\calls{PARSE-IteratorTail}{match-advance-string} +\calls{PARSE-IteratorTail}{bang} +\calls{PARSE-IteratorTail}{optional} +\calls{PARSE-IteratorTail}{star} +\calls{PARSE-IteratorTail}{PARSE-Iterator} +<>= +(defun |PARSE-IteratorTail| () + (or (and (match-advance-string "repeat") + (bang fil_test (optional (star repeator (|PARSE-Iterator|))))) + (star repeator (|PARSE-Iterator|)))) + +@ + +\defun{PARSE-Iterator}{PARSE-Iterator} +\calls{PARSE-Iterator}{match-advance-string} +\calls{PARSE-Iterator}{must} +\calls{PARSE-Iterator}{PARSE-Primary} +\calls{PARSE-Iterator}{PARSE-Expression} +\calls{PARSE-Iterator}{PARSE-Expr} +\calls{PARSE-Iterator}{pop-stack-3} +\calls{PARSE-Iterator}{pop-stack-2} +\calls{PARSE-Iterator}{pop-stack-1} +\calls{PARSE-Iterator}{optional} +<>= +(defun |PARSE-Iterator| () + (or (and (match-advance-string "for") (must (|PARSE-Primary|)) + (must (match-advance-string "in")) + (must (|PARSE-Expression|)) + (must (or (and (match-advance-string "by") + (must (|PARSE-Expr| 200)) + (push-reduction '|PARSE-Iterator| + (list 'inby (pop-stack-3) + (pop-stack-2) (pop-stack-1)))) + (push-reduction '|PARSE-Iterator| + (list 'in (pop-stack-2) (pop-stack-1))))) + (optional + (and (match-advance-string "|") + (must (|PARSE-Expr| 111)) + (push-reduction '|PARSE-Iterator| + (list '|\|| (pop-stack-1)))))) + (and (match-advance-string "while") (must (|PARSE-Expr| 190)) + (push-reduction '|PARSE-Iterator| + (list 'while (pop-stack-1)))) + (and (match-advance-string "until") (must (|PARSE-Expr| 190)) + (push-reduction '|PARSE-Iterator| + (list 'until (pop-stack-1)))))) + +@ +\subsection{The PARSE implicit routines} +These symbols are not explicitly referenced in the source. +Nevertheless, they are called during runtime. For example, +PARSE-SemiColon is called in the chain: +\begin{verbatim} + PARSE-Enclosure {loc0=nil,loc1="(V ==> Vector; "} [ihs=35] + PARSE-Expr + PARSE-LedPart + PARSE-Operation + PARSE-getSemanticForm + PARSE-SemiColon +\end{verbatim} +so there is a bit of indirection involved in the call. + +\defun{PARSE-Suffix}{PARSE-Suffix} +\calls{PARSE-Suffix}{push-reduction} +\calls{PARSE-Suffix}{current-symbol} +\calls{PARSE-Suffix}{action} +\calls{PARSE-Suffix}{advance-token} +\calls{PARSE-Suffix}{optional} +\calls{PARSE-Suffix}{PARSE-TokTail} +\calls{PARSE-Suffix}{pop-stack-1} +<>= +(defun |PARSE-Suffix| () + (and (push-reduction '|PARSE-Suffix| (current-symbol)) + (action (advance-token)) (optional (|PARSE-TokTail|)) + (push-reduction '|PARSE-Suffix| + (list (pop-stack-1) (pop-stack-1))))) + +@ + +\defun{PARSE-SemiColon}{PARSE-SemiColon} +\calls{PARSE-SemiColon}{match-advance-string} +\calls{PARSE-SemiColon}{must} +\calls{PARSE-SemiColon}{PARSE-Expr} +\calls{PARSE-SemiColon}{push-reduction} +\calls{PARSE-SemiColon}{pop-stack-2} +\calls{PARSE-SemiColon}{pop-stack-1} +<>= +(defun |PARSE-SemiColon| () + (and (match-advance-string ";") + (must (or (|PARSE-Expr| 82) + (push-reduction '|PARSE-SemiColon| '|/throwAway|))) + (push-reduction '|PARSE-SemiColon| + (list '|;| (pop-stack-2) (pop-stack-1))))) + +@ + +\defun{PARSE-Return}{PARSE-Return} +\calls{PARSE-Return}{match-advance-string} +\calls{PARSE-Return}{must} +\calls{PARSE-Return}{PARSE-Expression} +\calls{PARSE-Return}{push-reduction} +\calls{PARSE-Return}{pop-stack-1} +<>= +(defun |PARSE-Return| () + (and (match-advance-string "return") (must (|PARSE-Expression|)) + (push-reduction '|PARSE-Return| + (list '|return| (pop-stack-1))))) + +@ + +\defun{PARSE-Exit}{PARSE-Exit} +\calls{PARSE-Exit}{match-advance-string} +\calls{PARSE-Exit}{must} +\calls{PARSE-Exit}{PARSE-Expression} +\calls{PARSE-Exit}{push-reduction} +\calls{PARSE-Exit}{pop-stack-1} +<>= +(defun |PARSE-Exit| () + (and (match-advance-string "exit") + (must (or (|PARSE-Expression|) + (push-reduction '|PARSE-Exit| '|$NoValue|))) + (push-reduction '|PARSE-Exit| + (list '|exit| (pop-stack-1))))) + +@ + +\defun{PARSE-Leave}{PARSE-Leave} +\calls{PARSE-Leave}{match-advance-string} +\calls{PARSE-Leave}{PARSE-Expression} +\calls{PARSE-Leave}{must} +\calls{PARSE-Leave}{push-reduction} +\calls{PARSE-Leave}{PARSE-Label} +\calls{PARSE-Leave}{pop-stack-1} +<>= +(defun |PARSE-Leave| () + (and (match-advance-string "leave") + (must (or (|PARSE-Expression|) + (push-reduction '|PARSE-Leave| '|$NoValue|))) + (must (or (and (match-advance-string "from") + (must (|PARSE-Label|)) + (push-reduction '|PARSE-Leave| + (list '|leaveFrom| (pop-stack-1) (pop-stack-1)))) + (push-reduction '|PARSE-Leave| + (list '|leave| (pop-stack-1))))))) + +@ + +\defun{PARSE-Seg}{PARSE-Seg} +\calls{PARSE-Seg}{PARSE-GliphTok} +\calls{PARSE-Seg}{bang} +\calls{PARSE-Seg}{optional} +\calls{PARSE-Seg}{PARSE-Expression} +\calls{PARSE-Seg}{push-reduction} +\calls{PARSE-Seg}{pop-stack-2} +\calls{PARSE-Seg}{pop-stack-1} +<>= +(defun |PARSE-Seg| () + (and (|PARSE-GliphTok| '|..|) + (bang fil_test (optional (|PARSE-Expression|))) + (push-reduction '|PARSE-Seg| + (list 'segment (pop-stack-2) (pop-stack-1))))) + +@ + +\defun{PARSE-Conditional}{PARSE-Conditional} +\calls{PARSE-Conditional}{match-advance-string} +\calls{PARSE-Conditional}{must} +\calls{PARSE-Conditional}{PARSE-Expression} +\calls{PARSE-Conditional}{bang} +\calls{PARSE-Conditional}{optional} +\calls{PARSE-Conditional}{PARSE-ElseClause} +\calls{PARSE-Conditional}{push-reduction} +\calls{PARSE-Conditional}{pop-stack-3} +\calls{PARSE-Conditional}{pop-stack-2} +\calls{PARSE-Conditional}{pop-stack-1} +<>= +(defun |PARSE-Conditional| () + (and (match-advance-string "if") (must (|PARSE-Expression|)) + (must (match-advance-string "then")) (must (|PARSE-Expression|)) + (bang fil_test + (optional + (and (match-advance-string "else") + (must (|PARSE-ElseClause|))))) + (push-reduction '|PARSE-Conditional| + (list '|if| (pop-stack-3) (pop-stack-2) (pop-stack-1))))) + +@ + +\defun{PARSE-ElseClause}{PARSE-ElseClause} +\calls{PARSE-ElseClause}{current-symbol} +\calls{PARSE-ElseClause}{PARSE-Conditional} +\calls{PARSE-ElseClause}{PARSE-Expression} +<>= +(defun |PARSE-ElseClause| () + (or (and (eq (current-symbol) '|if|) (|PARSE-Conditional|)) + (|PARSE-Expression|))) + +@ + +\defun{PARSE-Loop}{PARSE-Loop} +\calls{PARSE-Loop}{star} +\calls{PARSE-Loop}{PARSE-Iterator} +\calls{PARSE-Loop}{must} +\calls{PARSE-Loop}{match-advance-string} +\calls{PARSE-Loop}{PARSE-Expr} +\calls{PARSE-Loop}{push-reduction} +\calls{PARSE-Loop}{pop-stack-2} +\calls{PARSE-Loop}{pop-stack-1} +<>= +(defun |PARSE-Loop| () + (or (and (star repeator (|PARSE-Iterator|)) + (must (match-advance-string "repeat")) + (must (|PARSE-Expr| 110)) + (push-reduction '|PARSE-Loop| + (cons 'repeat + (append (pop-stack-2) (list (pop-stack-1)))))) + (and (match-advance-string "repeat") (must (|PARSE-Expr| 110)) + (push-reduction '|PARSE-Loop| + (list 'repeat (pop-stack-1)))))) + +@ + +\defun{PARSE-LabelExpr}{PARSE-LabelExpr} +\calls{PARSE-LabelExpr}{PARSE-Label} +\calls{PARSE-LabelExpr}{must} +\calls{PARSE-LabelExpr}{PARSE-Expr} +\calls{PARSE-LabelExpr}{push-reduction} +\calls{PARSE-LabelExpr}{pop-stack-2} +\calls{PARSE-LabelExpr}{pop-stack-1} +<>= +(defun |PARSE-LabelExpr| () + (and (|PARSE-Label|) (must (|PARSE-Expr| 120)) + (push-reduction '|PARSE-LabelExpr| + (list 'label (pop-stack-2) (pop-stack-1))))) + +@ + +\defun{PARSE-FloatTok}{PARSE-FloatTok} +\calls{PARSE-FloatTok}{parse-number} +\calls{PARSE-FloatTok}{push-reduction} +\calls{PARSE-FloatTok}{pop-stack-1} +\calls{PARSE-FloatTok}{bfp-} +\usesdollar{PARSE-FloatTok}{boot} +<>= +(defun |PARSE-FloatTok| () + (and (parse-number) + (push-reduction '|PARSE-FloatTok| + (if $boot (pop-stack-1) (bfp- (pop-stack-1)))))) + +@ + + \section{The PARSE support routines} \subsection{Applying metagrammatical elements of a production (e.g., Star).} \begin{itemize} @@ -3888,8 +4335,8 @@ are performed upon recognizing the head and tail. \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) +<>= +(defmacro bang (lab prod) `(progn (setf (stack-updated reduce-stack) nil) (let* ((prodvalue ,prod) (updated (stack-updated reduce-stack))) @@ -7003,6 +7450,9 @@ if \verb|$InteractiveMode| then use a null outputstream <> +<> +<> +<> <> <> @@ -7055,7 +7505,9 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> +<> <> <> <> @@ -7106,31 +7558,46 @@ if \verb|$InteractiveMode| then use a null outputstream <> +<> <> <> <> <> +<> +<> +<> <> +<> <> <> <> <> <> <> +<> <> <> <> <> +<> <> <> <> <> +<> +<> <> +<> +<> <> <> +<> <> +<> <> <> +<> +<> <> <> <> @@ -7142,18 +7609,25 @@ if \verb|$InteractiveMode| then use a null outputstream <> <> <> +<> <> <> <> +<> <> +<> +<> +<> <> <> <> <> <> <> +<> <> <> +<> <> <> <> diff --git a/changelog b/changelog index e01e12a..a574196 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20101017 tpd src/axiom-website/patches.html 20101017.01.tpd.patch +20101017 tpd src/interp/vmlisp.lisp rename some fnewmeta variables +20101017 tpd src/interp/parsing.lisp move meta code into bookvol9 +20101017 tpd src/interp/Makefile merge and remove fnewmeta +20101017 tpd src/interp/fnewmeta.lisp removed +20101017 tpd books/bookvol9 merge and remove fnewmeta 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 diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index fa08af2..0b84fcd 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3226,5 +3226,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101016.04.tpd.patch books/bookvol9 treeshake compiler
+20101017.01.tpd.patch +books/bookvol9 merge and remove fnewmeta
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index b45b5cf..704226f 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -177,7 +177,7 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/sockio.${O} \ ${OUT}/template.${O} ${OUT}/termrw.${O} \ ${OUT}/fortcall.${O} \ - ${OUT}/parsing.${O} ${OUT}/fnewmeta.${O} \ + ${OUT}/parsing.${O} \ ${OUT}/postprop.lisp \ ${OUT}/apply.${O} ${OUT}/c-doc.${O} \ ${OUT}/c-util.${O} ${OUT}/profile.${O} \ @@ -590,7 +590,7 @@ of the form: <>= ${DEPSYS}: ${DEP} ${OUT}/sys-pkg.${LISP} ${OUT}/nocompil.${LISP} \ ${OUT}/bookvol5.${LISP} ${OUT}/util.${LISP} \ - ${OUT}/parsing.${LISP} ${OUT}/fnewmeta.${LISP} \ + ${OUT}/parsing.${LISP} \ ${OUT}/newaux.${LISP} \ ${OUT}/postprop.lisp \ ${OUT}/g-boot.lisp ${OUT}/c-util.lisp \ @@ -611,10 +611,6 @@ ${DEPSYS}: ${DEP} ${OUT}/sys-pkg.${LISP} ${OUT}/nocompil.${LISP} \ '(compile-file "${OUT}/parsing.${LISP}"' \ ':output-file "${OUT}/parsing.${O}"))' >> ${OUT}/makedep.lisp @ echo '(load "${OUT}/parsing")' >> ${OUT}/makedep.lisp - @ echo '(unless (probe-file "${OUT}/fnewmeta.${O}")' \ - '(compile-file "${OUT}/fnewmeta.${LISP}"' \ - ':output-file "${OUT}/fnewmeta.${O}"))' >> ${OUT}/makedep.lisp - @ echo '(load "${OUT}/fnewmeta")' >> ${OUT}/makedep.lisp @ echo '(unless (probe-file "${OUT}/newaux.${O}")' \ '(compile-file "${OUT}/newaux.${LISP}"' \ ':output-file "${OUT}/newaux.${O}"))' >> ${OUT}/makedep.lisp @@ -816,44 +812,6 @@ ${MID}/debugsys.lisp: ${IN}/debugsys.lisp.pamphlet @ -\subsection{fnewmeta.lisp \cite{18}} -<>= -${AUTO}/fnewmeta.${O}: ${OUT}/fnewmeta.${O} - @ echo 49 making ${AUTO}/fnewmeta.${O} from ${OUT}/fnewmeta.${O} - @ cp ${OUT}/fnewmeta.${O} ${AUTO} - -@ -<>= -${OUT}/fnewmeta.${O}: ${MID}/fnewmeta.lisp - @ echo 50 making ${OUT}/fnewmeta.${O} from ${MID}/fnewmeta.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/fnewmeta.lisp"' \ - ':output-file "${OUT}/fnewmeta.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/fnewmeta.lisp"' \ - ':output-file "${OUT}/fnewmeta.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${OUT}/fnewmeta.${LISP}: ${IN}/fnewmeta.lisp.pamphlet - @ echo 51 making ${OUT}/fnewmeta.${LISP} \ - from ${MID}/fnewmeta.lisp.pamphlet - @ rm -f ${OUT}/fnewmeta.${O} - @ ( cd ${OUT} ; \ - ${TANGLE} ${IN}/fnewmeta.lisp.pamphlet >fnewmeta.${LISP} ) - -@ -<>= -${MID}/fnewmeta.lisp: ${IN}/fnewmeta.lisp.pamphlet - @ echo 52 making ${MID}/fnewmeta.lisp from ${IN}/fnewmeta.lisp.pamphlet - @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/fnewmeta.lisp.pamphlet >fnewmeta.lisp ) - -@ - \subsection{fortcall.lisp} <>= ${OUT}/fortcall.${O}: ${MID}/fortcall.lisp @@ -3419,11 +3377,6 @@ clean: <> <> -<> -<> -<> -<> - <> <> diff --git a/src/interp/fnewmeta.lisp.pamphlet b/src/interp/fnewmeta.lisp.pamphlet deleted file mode 100644 index 60954b0..0000000 --- a/src/interp/fnewmeta.lisp.pamphlet +++ /dev/null @@ -1,1008 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp fnewmeta.lisp} -\author{William Burge} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -<>= -% Scratchpad II Boot Language Grammar, Common Lisp Version -% IBM Thomas J. Watson Research Center -% Summer, 1986 -% -% NOTE: Substantially different from VM/LISP version, due to -% different parser and attempt to render more within META proper. - -.META(New NewExpr Process) -.PACKAGE 'BOOT' -.DECLARE(tmptok TOK ParseMode DEFINITION_NAME LABLASOC) -.PREFIX 'PARSE-' - -NewExpr: =')' .(processSynonyms) Command - / .(SETQ DEFINITION_NAME (CURRENT-SYMBOL)) Statement ; - -Command: ')' SpecialKeyWord SpecialCommand +() ; - -SpecialKeyWord: =(MATCH-CURRENT-TOKEN "IDENTIFIER) - .(SETF (TOKEN-SYMBOL (CURRENT-TOKEN)) (unAbbreviateKeyword (CURRENT-SYMBOL))) ; - -SpecialCommand: 'show' <'?' / Expression>! +(show #1) CommandTail - / ?(MEMBER (CURRENT-SYMBOL) \$noParseCommands) - .(FUNCALL (CURRENT-SYMBOL)) - / ?(MEMBER (CURRENT-SYMBOL) \$tokenCommands) TokenList - TokenCommandTail - / PrimaryOrQM* CommandTail ; - -TokenList: (^?(isTokenDelimiter) +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN))* ; - -TokenCommandTail: - ! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ; - -TokenOption: ')' TokenList ; - -CommandTail: ! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ; - -PrimaryOrQM: '?' +\? / Primary ; - -Option: ')' PrimaryOrQM* ; - -Statement: Expr{0} <(',' Expr{0})* +(Series #2 -#1)>; - -InfixWith: With +(Join #2 #1) ; - -With: 'with' Category +(with #1) ; - -Category: 'if' Expression 'then' Category <'else' Category>! +(if #3 #2 #1) - / '(' Category <(';' Category)*>! ')' +(CATEGORY #2 -#1) - / .(SETQ $1 (LINE-NUMBER CURRENT-LINE)) Application - ( ':' Expression +(Signature #2 #1) - .(recordSignatureDocumentation ##1 $1) - / +(Attribute #1) - .(recordAttributeDocumentation ##1 $1)); - -Expression: Expr{(PARSE-rightBindingPowerOf (MAKE-SYMBOL-OF PRIOR-TOKEN) ParseMode)} - +#1 ; - -Import: 'import' Expr{1000} <(',' Expr{1000})*>! +(import #2 -#1) ; - -Infix: =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) - Expression +(#2 #2 #1) ; - -Prefix: =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) - Expression +(#2 #1) ; - -Suffix: +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) +(#1 #1) ; - -TokTail: ?(AND (NULL \$BOOT) (EQ (CURRENT-SYMBOL) "\$) - (OR (ALPHA-CHAR-P (CURRENT-CHAR)) - (CHAR-EQ (CURRENT-CHAR) '$') - (CHAR-EQ (CURRENT-CHAR) '\%') - (CHAR-EQ (CURRENT-CHAR) '('))) - .(SETQ $1 (COPY-TOKEN PRIOR-TOKEN)) Qualification - .(SETQ PRIOR-TOKEN $1) ; - -Qualification: '$' Primary1 +=(dollarTran #1 #1) ; - -SemiColon: ';' (Expr{82} / + \/throwAway) +(\; #2 #1) ; - -Return: 'return' Expression +(return #1) ; - -Exit: 'exit' (Expression / +\$NoValue) +(exit #1) ; - -Leave: 'leave' ( Expression / +\$NoValue ) - ('from' Label +(leaveFrom #1 #1) / +(leave #1)) ; - -Seg: GliphTok{"\.\.} ! +(SEGMENT #2 #1) ; - -Conditional: 'if' Expression 'then' Expression <'else' ElseClause>! - +(if #3 #2 #1) ; - -ElseClause: ?(EQ (CURRENT-SYMBOL) "if) Conditional / Expression ; - -Loop: Iterator* 'repeat' Expr{110} +(REPEAT -#2 #1) - / 'repeat' Expr{110} +(REPEAT #1) ; - -Iterator: 'for' Primary 'in' Expression - ( 'by' Expr{200} +(INBY #3 #2 #1) / +(IN #2 #1) ) - < '\|' Expr{111} +(\| #1) > - / 'while' Expr{190} +(WHILE #1) - / 'until' Expr{190} +(UNTIL #1) ; - -Expr{RBP}: NudPart{RBP} * +#1; - -LabelExpr: Label Expr{120} +(LABEL #2 #1) ; - -Label: '<<' Name '>>' ; - -LedPart{RBP}: Operation{"Led RBP} +#1; - -NudPart{RBP}: (Operation{"Nud RBP} / Reduction / Form) +#1 ; - -Operation{ParseMode RBP}: - ^?(MATCH-CURRENT-TOKEN "IDENTIFIER) - ?(GETL (SETQ tmptok (CURRENT-SYMBOL)) ParseMode) - ?(LT RBP (PARSE-leftBindingPowerOf tmptok ParseMode)) - .(SETQ RBP (PARSE-rightBindingPowerOf tmptok ParseMode)) - getSemanticForm{tmptok ParseMode (ELEMN (GETL tmptok ParseMode) 5 NIL)} ; - -% Binding powers stored under the Led and Red properties of an operator -% are set up by the file BOTTOMUP.LISP. The format for a Led property -% is , and the same for a Nud, except that -% it may also have a fourth component . ELEMN attempts to -% get the Nth indicator, counting from 1. - -leftBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0)) ; - -rightBindingPowerOf{X IND}: =(LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105)) ; - -getSemanticForm{X IND Y}: - ?(AND Y (EVAL Y)) / ?(EQ IND "Nud) Prefix / ?(EQ IND "Led) Infix ; - - -Reduction: ReductionOp Expr{1000} +(Reduce #2 #1) ; - -ReductionOp: ?(AND (GETL (CURRENT-SYMBOL) "Led) - (MATCH-NEXT-TOKEN "SPECIAL-CHAR (CODE-CHAR 47))) % Forgive me! - +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) .(ADVANCE-TOKEN) ; - -Form: 'iterate' < 'from' Label +(#1) >! +(iterate -#1) - / 'yield' Application +(yield #1) - / Application ; - -Application: Primary * ; - -Selector: ?NONBLANK ?(EQ (CURRENT-SYMBOL) "\.) ?(CHAR-NE (CURRENT-CHAR) "\ ) - '.' PrimaryNoFloat (=\$BOOT +(ELT #2 #1)/ +(#2 #1)) - / (Float /'.' Primary) (=\$BOOT +(ELT #2 #1)/ +(#2 #1)); - -PrimaryNoFloat: Primary1 ; - -Primary: Float /PrimaryNoFloat ; - -Primary1: VarForm <=(AND NONBLANK (EQ (CURRENT-SYMBOL) "\()) Primary1 +(#2 #1)> - /Quad - /String - /IntegerTok - /FormalParameter - /='\'' (?\$BOOT Data / '\'' Expr{999} +(QUOTE #1)) - /Sequence - /Enclosure ; - -Float: FloatBase (?NONBLANK FloatExponent / +0) +=(MAKE-FLOAT #4 #2 #2 #1) ; - -FloatBase: ?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CURRENT-CHAR) '.') - ?(CHAR-NE (NEXT-CHAR) '.') - IntegerTok FloatBasePart - /?(FIXP (CURRENT-SYMBOL)) ?(CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) "E) - IntegerTok +0 +0 - /?(DIGITP (CURRENT-CHAR)) ?(EQ (CURRENT-SYMBOL) "\.) - +0 FloatBasePart ; - -FloatBasePart: '.' - (?(DIGITP (CURRENT-CHAR)) +=(TOKEN-NONBLANK (CURRENT-TOKEN)) IntegerTok - / +0 +0); - - -FloatExponent: =(AND (MEMBER (CURRENT-SYMBOL) "(E e)) - (FIND (CURRENT-CHAR) '+-')) - .(ADVANCE-TOKEN) - (IntegerTok/'+' IntegerTok/'-' IntegerTok +=(MINUS #1)/+0) - /?(IDENTP (CURRENT-SYMBOL)) =(SETQ $1 (FLOATEXPID (CURRENT-SYMBOL))) - .(ADVANCE-TOKEN) +=$1 ; - -Enclosure: '(' ( Expr{6} ')' / ')' +(\@Tuple) ) - / '{' ( Expr{6} '}' +(brace (construct #1)) / '}' +(brace)) ; - -IntegerTok: NUMBER ; - -FloatTok: NUMBER +=(IF \$BOOT #1 (BFP- #1)) ; - -FormalParameter: FormalParameterTok ; - -FormalParameterTok: ARGUMENT-DESIGNATOR ; - -Quad: '$' +\$ / ?\$BOOT GliphTok{"\.} +\. ; - -String: SPADSTRING ; - -VarForm: Name +#1 ; - -Scripts: ?NONBLANK '[' ScriptItem ']' ; - -ScriptItem: Expr{90} <(';' ScriptItem)* +(\; #2 -#1)> - / ';' ScriptItem +(PrefixSC #1) ; - -Name: IDENTIFIER +#1 ; - -Data: .(SETQ LABLASOC NIL) Sexpr +(QUOTE =(TRANSLABEL #1 LABLASOC)) ; - -Sexpr: .(ADVANCE-TOKEN) Sexpr1 ; - -Sexpr1: AnyId - < NBGliphTok{"\=} Sexpr1 - .(SETQ LABLASOC (CONS (CONS #2 ##1) LABLASOC))> - / '\'' Sexpr1 +(QUOTE #1) - / IntegerTok - / '-' IntegerTok +=(MINUS #1) - / String - / '<' ! '>' +=(LIST2VEC #1) - / '(' >! ')' ; - -NBGliphTok{tok}: ?(AND (MATCH-CURRENT-TOKEN "GLIPH tok) NONBLANK) - .(ADVANCE-TOKEN) ; - -GliphTok{tok}: ?(MATCH-CURRENT-TOKEN "GLIPH tok) .(ADVANCE-TOKEN) ; - -AnyId: IDENTIFIER - / (='$' +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) / KEYWORD) ; - -Sequence: OpenBracket Sequence1 ']' - / OpenBrace Sequence1 '}' +(brace #1) ; - -Sequence1: (Expression +(#2 #1) / +(#1)) ; - -OpenBracket: =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\[ ) - (=(EQCAR $1 "elt) +(elt =(CADR $1) construct) - / +construct) .(ADVANCE-TOKEN) ; - -OpenBrace: =(EQ (getToken (SETQ $1 (CURRENT-SYMBOL))) "\{ ) - (=(EQCAR $1 "elt) +(elt =(CADR $1) brace) - / +construct) .(ADVANCE-TOKEN) ; - -IteratorTail: ('repeat' ! / Iterator*) ; - -.FIN ; - - -@ -\section{License} -<>= -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are -;; met: -;; -;; - Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; -;; - Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in -;; the documentation and/or other materials provided with the -;; distribution. -;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the -;; names of its contributors may be used to endorse or promote products -;; derived from this software without specific prior written permission. -;; -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -(IN-PACKAGE "BOOT" ) - - -(DEFPARAMETER |tmptok| NIL) -(DEFPARAMETER TOK NIL) -(DEFPARAMETER |ParseMode| NIL) -(DEFPARAMETER DEFINITION_NAME NIL) -(DEFPARAMETER LABLASOC NIL) - - -(DEFUN |PARSE-NewExpr| () - (OR (AND (MATCH-STRING ")") (ACTION (|processSynonyms|)) - (MUST (|PARSE-Command|))) - (AND (ACTION (SETQ DEFINITION_NAME (CURRENT-SYMBOL))) - (|PARSE-Statement|)))) - - -(DEFUN |PARSE-Command| () - (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-SpecialKeyWord|)) - (MUST (|PARSE-SpecialCommand|)) - (PUSH-REDUCTION '|PARSE-Command| NIL))) - - -(DEFUN |PARSE-SpecialKeyWord| () - (AND (MATCH-CURRENT-TOKEN 'IDENTIFIER) - (ACTION (SETF (TOKEN-SYMBOL (CURRENT-TOKEN)) - (|unAbbreviateKeyword| (CURRENT-SYMBOL)))))) - - -(DEFUN |PARSE-SpecialCommand| () - (OR (AND (MATCH-ADVANCE-STRING "show") - (BANG FIL_TEST - (OPTIONAL - (OR (MATCH-ADVANCE-STRING "?") - (|PARSE-Expression|)))) - (PUSH-REDUCTION '|PARSE-SpecialCommand| - (CONS '|show| (CONS (POP-STACK-1) NIL))) - (MUST (|PARSE-CommandTail|))) - (AND (MEMBER (CURRENT-SYMBOL) |$noParseCommands|) - (ACTION (FUNCALL (CURRENT-SYMBOL)))) - (AND (MEMBER (CURRENT-SYMBOL) |$tokenCommands|) - (|PARSE-TokenList|) (MUST (|PARSE-TokenCommandTail|))) - (AND (STAR REPEATOR (|PARSE-PrimaryOrQM|)) - (MUST (|PARSE-CommandTail|))))) - - -(DEFUN |PARSE-TokenList| () - (STAR REPEATOR - (AND (NOT (|isTokenDelimiter|)) - (PUSH-REDUCTION '|PARSE-TokenList| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN))))) - - -(DEFUN |PARSE-TokenCommandTail| () - (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-TokenOption|)))) - (|atEndOfLine|) - (PUSH-REDUCTION '|PARSE-TokenCommandTail| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))) - (ACTION (|systemCommand| (POP-STACK-1))))) - - -(DEFUN |PARSE-TokenOption| () - (AND (MATCH-ADVANCE-STRING ")") (MUST (|PARSE-TokenList|)))) - - -(DEFUN |PARSE-CommandTail| () - (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|)))) - (|atEndOfLine|) - (PUSH-REDUCTION '|PARSE-CommandTail| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL))) - (ACTION (|systemCommand| (POP-STACK-1))))) - - -(DEFUN |PARSE-PrimaryOrQM| () - (OR (AND (MATCH-ADVANCE-STRING "?") - (PUSH-REDUCTION '|PARSE-PrimaryOrQM| '?)) - (|PARSE-Primary|))) - - -(DEFUN |PARSE-Option| () - (AND (MATCH-ADVANCE-STRING ")") - (MUST (STAR REPEATOR (|PARSE-PrimaryOrQM|))))) - - -(DEFUN |PARSE-Statement| () - (AND (|PARSE-Expr| 0) - (OPTIONAL - (AND (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ",") - (MUST (|PARSE-Expr| 0)))) - (PUSH-REDUCTION '|PARSE-Statement| - (CONS '|Series| - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL)))))))) - - -(DEFUN |PARSE-InfixWith| () - (AND (|PARSE-With|) - (PUSH-REDUCTION '|PARSE-InfixWith| - (CONS '|Join| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-With| () - (AND (MATCH-ADVANCE-STRING "with") (MUST (|PARSE-Category|)) - (PUSH-REDUCTION '|PARSE-With| - (CONS '|with| (CONS (POP-STACK-1) NIL))))) - - -(DEFUN |PARSE-Category| () - (PROG (G1) - (RETURN - (OR (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-STRING "then")) - (MUST (|PARSE-Category|)) - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "else") - (MUST (|PARSE-Category|))))) - (PUSH-REDUCTION '|PARSE-Category| - (CONS '|if| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (AND (MATCH-ADVANCE-STRING "(") (MUST (|PARSE-Category|)) - (BANG FIL_TEST - (OPTIONAL - (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ";") - (MUST (|PARSE-Category|)))))) - (MUST (MATCH-ADVANCE-STRING ")")) - (PUSH-REDUCTION '|PARSE-Category| - (CONS 'CATEGORY - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))) - (AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE))) - (|PARSE-Application|) - (MUST (OR (AND (MATCH-ADVANCE-STRING ":") - (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Category| - (CONS '|Signature| - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))) - (ACTION (|recordSignatureDocumentation| - (NTH-STACK 1) G1))) - (AND (PUSH-REDUCTION '|PARSE-Category| - (CONS '|Attribute| - (CONS (POP-STACK-1) NIL))) - (ACTION (|recordAttributeDocumentation| - (NTH-STACK 1) G1)))))))))) - - -(DEFUN |PARSE-Expression| () - (AND (|PARSE-Expr| - (|PARSE-rightBindingPowerOf| (MAKE-SYMBOL-OF PRIOR-TOKEN) - |ParseMode|)) - (PUSH-REDUCTION '|PARSE-Expression| (POP-STACK-1)))) - - -(DEFUN |PARSE-Import| () - (AND (MATCH-ADVANCE-STRING "import") (MUST (|PARSE-Expr| 1000)) - (BANG FIL_TEST - (OPTIONAL - (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ",") - (MUST (|PARSE-Expr| 1000)))))) - (PUSH-REDUCTION '|PARSE-Import| - (CONS '|import| - (CONS (POP-STACK-2) (APPEND (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Infix| () - (AND (PUSH-REDUCTION '|PARSE-Infix| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) - (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Infix| - (CONS (POP-STACK-2) - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Prefix| () - (AND (PUSH-REDUCTION '|PARSE-Prefix| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) - (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Prefix| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) - - -(DEFUN |PARSE-Suffix| () - (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) - (PUSH-REDUCTION '|PARSE-Suffix| - (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL))))) - - -(DEFUN |PARSE-TokTail| () - (PROG (G1) - (RETURN - (AND (NULL $BOOT) (EQ (CURRENT-SYMBOL) '$) - (OR (ALPHA-CHAR-P (CURRENT-CHAR)) - (CHAR-EQ (CURRENT-CHAR) "$") - (CHAR-EQ (CURRENT-CHAR) "%") - (CHAR-EQ (CURRENT-CHAR) "(")) - (ACTION (SETQ G1 (COPY-TOKEN PRIOR-TOKEN))) - (|PARSE-Qualification|) (ACTION (SETQ PRIOR-TOKEN G1)))))) - - -(DEFUN |PARSE-Qualification| () - (AND (MATCH-ADVANCE-STRING "$") (MUST (|PARSE-Primary1|)) - (PUSH-REDUCTION '|PARSE-Qualification| - (|dollarTran| (POP-STACK-1) (POP-STACK-1))))) - - -(DEFUN |PARSE-SemiColon| () - (AND (MATCH-ADVANCE-STRING ";") - (MUST (OR (|PARSE-Expr| 82) - (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|))) - (PUSH-REDUCTION '|PARSE-SemiColon| - (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Return| () - (AND (MATCH-ADVANCE-STRING "return") (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Return| - (CONS '|return| (CONS (POP-STACK-1) NIL))))) - - -(DEFUN |PARSE-Exit| () - (AND (MATCH-ADVANCE-STRING "exit") - (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|))) - (PUSH-REDUCTION '|PARSE-Exit| - (CONS '|exit| (CONS (POP-STACK-1) NIL))))) - - -(DEFUN |PARSE-Leave| () - (AND (MATCH-ADVANCE-STRING "leave") - (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|))) - (MUST (OR (AND (MATCH-ADVANCE-STRING "from") - (MUST (|PARSE-Label|)) - (PUSH-REDUCTION '|PARSE-Leave| - (CONS '|leaveFrom| - (CONS (POP-STACK-1) - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Leave| - (CONS '|leave| (CONS (POP-STACK-1) NIL))))))) - - -(DEFUN |PARSE-Seg| () - (AND (|PARSE-GliphTok| '|..|) - (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|))) - (PUSH-REDUCTION '|PARSE-Seg| - (CONS 'SEGMENT - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Conditional| () - (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-STRING "then")) (MUST (|PARSE-Expression|)) - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "else") - (MUST (|PARSE-ElseClause|))))) - (PUSH-REDUCTION '|PARSE-Conditional| - (CONS '|if| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) - - -(DEFUN |PARSE-ElseClause| () - (OR (AND (EQ (CURRENT-SYMBOL) '|if|) (|PARSE-Conditional|)) - (|PARSE-Expression|))) - - -(DEFUN |PARSE-Loop| () - (OR (AND (STAR REPEATOR (|PARSE-Iterator|)) - (MUST (MATCH-ADVANCE-STRING "repeat")) - (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| - (CONS 'REPEAT - (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) - (AND (MATCH-ADVANCE-STRING "repeat") (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| - (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Iterator| () - (OR (AND (MATCH-ADVANCE-STRING "for") (MUST (|PARSE-Primary|)) - (MUST (MATCH-ADVANCE-STRING "in")) - (MUST (|PARSE-Expression|)) - (MUST (OR (AND (MATCH-ADVANCE-STRING "by") - (MUST (|PARSE-Expr| 200)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'INBY - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'IN - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "|") - (MUST (|PARSE-Expr| 111)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS '|\|| (CONS (POP-STACK-1) NIL)))))) - (AND (MATCH-ADVANCE-STRING "while") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'WHILE (CONS (POP-STACK-1) NIL)))) - (AND (MATCH-ADVANCE-STRING "until") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'UNTIL (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Expr| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (|PARSE-NudPart| RBP) - (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP))) - (PUSH-REDUCTION '|PARSE-Expr| (POP-STACK-1)))) - - -(DEFUN |PARSE-LabelExpr| () - (AND (|PARSE-Label|) (MUST (|PARSE-Expr| 120)) - (PUSH-REDUCTION '|PARSE-LabelExpr| - (CONS 'LABEL (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Label| () - (AND (MATCH-ADVANCE-STRING "<<") (MUST (|PARSE-Name|)) - (MUST (MATCH-ADVANCE-STRING ">>")))) - - -(DEFUN |PARSE-LedPart| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (|PARSE-Operation| '|Led| RBP) - (PUSH-REDUCTION '|PARSE-LedPart| (POP-STACK-1)))) - - -(DEFUN |PARSE-NudPart| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|) - (|PARSE-Form|)) - (PUSH-REDUCTION '|PARSE-NudPart| (POP-STACK-1)))) - - -(DEFUN |PARSE-Operation| (|ParseMode| RBP) - (DECLARE (SPECIAL |ParseMode| RBP)) - (AND (NOT (MATCH-CURRENT-TOKEN 'IDENTIFIER)) - (GETL (SETQ |tmptok| (CURRENT-SYMBOL)) |ParseMode|) - (LT RBP (|PARSE-leftBindingPowerOf| |tmptok| |ParseMode|)) - (ACTION (SETQ RBP - (|PARSE-rightBindingPowerOf| |tmptok| |ParseMode|))) - (|PARSE-getSemanticForm| |tmptok| |ParseMode| - (ELEMN (GETL |tmptok| |ParseMode|) 5 NIL)))) - - -(DEFUN |PARSE-leftBindingPowerOf| (X IND) - (DECLARE (SPECIAL X IND)) - (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 3 0) 0))) - - -(DEFUN |PARSE-rightBindingPowerOf| (X IND) - (DECLARE (SPECIAL X IND)) - (LET ((Y (GETL X IND))) (IF Y (ELEMN Y 4 105) 105))) - - -(DEFUN |PARSE-getSemanticForm| (X IND Y) - (DECLARE (SPECIAL X IND Y)) - (OR (AND Y (EVAL Y)) (AND (EQ IND '|Nud|) (|PARSE-Prefix|)) - (AND (EQ IND '|Led|) (|PARSE-Infix|)))) - - -(DEFUN |PARSE-Reduction| () - (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000)) - (PUSH-REDUCTION '|PARSE-Reduction| - (CONS '|Reduce| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-ReductionOp| () - (AND (GETL (CURRENT-SYMBOL) '|Led|) - (MATCH-NEXT-TOKEN 'SPECIAL-CHAR (CODE-CHAR 47)) - (PUSH-REDUCTION '|PARSE-ReductionOp| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN)) (ACTION (ADVANCE-TOKEN)))) - - -(DEFUN |PARSE-Form| () - (OR (AND (MATCH-ADVANCE-STRING "iterate") - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "from") - (MUST (|PARSE-Label|)) - (PUSH-REDUCTION '|PARSE-Form| - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Form| - (CONS '|iterate| (APPEND (POP-STACK-1) NIL)))) - (AND (MATCH-ADVANCE-STRING "yield") (MUST (|PARSE-Application|)) - (PUSH-REDUCTION '|PARSE-Form| - (CONS '|yield| (CONS (POP-STACK-1) NIL)))) - (|PARSE-Application|))) - - -(DEFUN |PARSE-Application| () - (AND (|PARSE-Primary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|))) - (OPTIONAL - (AND (|PARSE-Application|) - (PUSH-REDUCTION '|PARSE-Application| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) - - -(DEFUN |PARSE-Selector| () - (OR (AND NONBLANK (EQ (CURRENT-SYMBOL) '|.|) - (CHAR-NE (CURRENT-CHAR) '| |) (MATCH-ADVANCE-STRING ".") - (MUST (|PARSE-PrimaryNoFloat|)) - (MUST (OR (AND $BOOT - (PUSH-REDUCTION '|PARSE-Selector| - (CONS 'ELT - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Selector| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - (AND (OR (|PARSE-Float|) - (AND (MATCH-ADVANCE-STRING ".") - (MUST (|PARSE-Primary|)))) - (MUST (OR (AND $BOOT - (PUSH-REDUCTION '|PARSE-Selector| - (CONS 'ELT - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Selector| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))) - - -(DEFUN |PARSE-PrimaryNoFloat| () - (AND (|PARSE-Primary1|) (OPTIONAL (|PARSE-TokTail|)))) - - -(DEFUN |PARSE-Primary| () - (OR (|PARSE-Float|) (|PARSE-PrimaryNoFloat|))) - - -(DEFUN |PARSE-Primary1| () - (OR (AND (|PARSE-VarForm|) - (OPTIONAL - (AND NONBLANK (EQ (CURRENT-SYMBOL) '|(|) - (MUST (|PARSE-Primary1|)) - (PUSH-REDUCTION '|PARSE-Primary1| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|) - (|PARSE-FormalParameter|) - (AND (MATCH-STRING "'") - (MUST (OR (AND $BOOT (|PARSE-Data|)) - (AND (MATCH-ADVANCE-STRING "'") - (MUST (|PARSE-Expr| 999)) - (PUSH-REDUCTION '|PARSE-Primary1| - (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))))) - (|PARSE-Sequence|) (|PARSE-Enclosure|))) - - -(DEFUN |PARSE-Float| () - (AND (|PARSE-FloatBase|) - (MUST (OR (AND NONBLANK (|PARSE-FloatExponent|)) - (PUSH-REDUCTION '|PARSE-Float| 0))) - (PUSH-REDUCTION '|PARSE-Float| - (MAKE-FLOAT (POP-STACK-4) (POP-STACK-2) (POP-STACK-2) - (POP-STACK-1))))) - - -(DEFUN |PARSE-FloatBase| () - (OR (AND (integerp (CURRENT-SYMBOL)) (CHAR-EQ (CURRENT-CHAR) ".") - (CHAR-NE (NEXT-CHAR) ".") (|PARSE-IntegerTok|) - (MUST (|PARSE-FloatBasePart|))) - (AND (integerp (CURRENT-SYMBOL)) - (CHAR-EQ (CHAR-UPCASE (CURRENT-CHAR)) 'E) - (|PARSE-IntegerTok|) (PUSH-REDUCTION '|PARSE-FloatBase| 0) - (PUSH-REDUCTION '|PARSE-FloatBase| 0)) - (AND (DIGITP (CURRENT-CHAR)) (EQ (CURRENT-SYMBOL) '|.|) - (PUSH-REDUCTION '|PARSE-FloatBase| 0) - (|PARSE-FloatBasePart|)))) - - -(DEFUN |PARSE-FloatBasePart| () - (AND (MATCH-ADVANCE-STRING ".") - (MUST (OR (AND (DIGITP (CURRENT-CHAR)) - (PUSH-REDUCTION '|PARSE-FloatBasePart| - (TOKEN-NONBLANK (CURRENT-TOKEN))) - (|PARSE-IntegerTok|)) - (AND (PUSH-REDUCTION '|PARSE-FloatBasePart| 0) - (PUSH-REDUCTION '|PARSE-FloatBasePart| 0)))))) - - -(DEFUN |PARSE-FloatExponent| () - (PROG (G1) - (RETURN - (OR (AND (MEMBER (CURRENT-SYMBOL) '(E |e|)) - (FIND (CURRENT-CHAR) "+-") (ACTION (ADVANCE-TOKEN)) - (MUST (OR (|PARSE-IntegerTok|) - (AND (MATCH-ADVANCE-STRING "+") - (MUST (|PARSE-IntegerTok|))) - (AND (MATCH-ADVANCE-STRING "-") - (MUST (|PARSE-IntegerTok|)) - (PUSH-REDUCTION '|PARSE-FloatExponent| - (MINUS (POP-STACK-1)))) - (PUSH-REDUCTION '|PARSE-FloatExponent| 0)))) - (AND (IDENTP (CURRENT-SYMBOL)) - (SETQ G1 (FLOATEXPID (CURRENT-SYMBOL))) - (ACTION (ADVANCE-TOKEN)) - (PUSH-REDUCTION '|PARSE-FloatExponent| G1)))))) - - -(DEFUN |PARSE-Enclosure| () - (OR (AND (MATCH-ADVANCE-STRING "(") - (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (MATCH-ADVANCE-STRING ")"))) - (AND (MATCH-ADVANCE-STRING ")") - (PUSH-REDUCTION '|PARSE-Enclosure| - (CONS '|@Tuple| NIL)))))) - (AND (MATCH-ADVANCE-STRING "{") - (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION '|PARSE-Enclosure| - (CONS '|brace| - (CONS - (CONS '|construct| - (CONS (POP-STACK-1) NIL)) - NIL)))) - (AND (MATCH-ADVANCE-STRING "}") - (PUSH-REDUCTION '|PARSE-Enclosure| - (CONS '|brace| NIL)))))))) - - -(DEFUN |PARSE-IntegerTok| () (PARSE-NUMBER)) - - -(DEFUN |PARSE-FloatTok| () - (AND (PARSE-NUMBER) - (PUSH-REDUCTION '|PARSE-FloatTok| - (IF $BOOT (POP-STACK-1) (BFP- (POP-STACK-1)))))) - - -(DEFUN |PARSE-FormalParameter| () (|PARSE-FormalParameterTok|)) - - -(DEFUN |PARSE-FormalParameterTok| () (PARSE-ARGUMENT-DESIGNATOR)) - - -(DEFUN |PARSE-Quad| () - (OR (AND (MATCH-ADVANCE-STRING "$") - (PUSH-REDUCTION '|PARSE-Quad| '$)) - (AND $BOOT (|PARSE-GliphTok| '|.|) - (PUSH-REDUCTION '|PARSE-Quad| '|.|)))) - - -(DEFUN |PARSE-String| () (PARSE-SPADSTRING)) - - -(DEFUN |PARSE-VarForm| () - (AND (|PARSE-Name|) - (OPTIONAL - (AND (|PARSE-Scripts|) - (PUSH-REDUCTION '|PARSE-VarForm| - (CONS '|Scripts| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) - (PUSH-REDUCTION '|PARSE-VarForm| (POP-STACK-1)))) - - -(DEFUN |PARSE-Scripts| () - (AND NONBLANK (MATCH-ADVANCE-STRING "[") (MUST (|PARSE-ScriptItem|)) - (MUST (MATCH-ADVANCE-STRING "]")))) - - -(DEFUN |PARSE-ScriptItem| () - (OR (AND (|PARSE-Expr| 90) - (OPTIONAL - (AND (STAR REPEATOR - (AND (MATCH-ADVANCE-STRING ";") - (MUST (|PARSE-ScriptItem|)))) - (PUSH-REDUCTION '|PARSE-ScriptItem| - (CONS '|;| - (CONS (POP-STACK-2) - (APPEND (POP-STACK-1) NIL))))))) - (AND (MATCH-ADVANCE-STRING ";") (MUST (|PARSE-ScriptItem|)) - (PUSH-REDUCTION '|PARSE-ScriptItem| - (CONS '|PrefixSC| (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Name| () - (AND (PARSE-IDENTIFIER) (PUSH-REDUCTION '|PARSE-Name| (POP-STACK-1)))) - - -(DEFUN |PARSE-Data| () - (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|) - (PUSH-REDUCTION '|PARSE-Data| - (CONS 'QUOTE (CONS (TRANSLABEL (POP-STACK-1) LABLASOC) NIL))))) - - -(DEFUN |PARSE-Sexpr| () - (AND (ACTION (ADVANCE-TOKEN)) (|PARSE-Sexpr1|))) - - -(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 ")"))))) - - -(DEFUN |PARSE-NBGliphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) NONBLANK - (ACTION (ADVANCE-TOKEN)))) - - -(DEFUN |PARSE-GliphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) (ACTION (ADVANCE-TOKEN)))) - - -(DEFUN |PARSE-AnyId| () - (OR (PARSE-IDENTIFIER) - (OR (AND (MATCH-STRING "$") - (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN))) - (PARSE-KEYWORD)))) - - -(DEFUN |PARSE-Sequence| () - (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "]"))) - (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION '|PARSE-Sequence| - (CONS '|brace| (CONS (POP-STACK-1) NIL)))))) - - -(DEFUN |PARSE-Sequence1| () - (AND (OR (AND (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Sequence1| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))) - (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL))) - (OPTIONAL - (AND (|PARSE-IteratorTail|) - (PUSH-REDUCTION '|PARSE-Sequence1| - (CONS 'COLLECT - (APPEND (POP-STACK-1) - (CONS (POP-STACK-1) NIL)))))))) - - -(DEFUN |PARSE-OpenBracket| () - (PROG (G1) - (RETURN - (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '[) - (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBracket| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|construct| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|))) - (ACTION (ADVANCE-TOKEN)))))) - - -(DEFUN |PARSE-OpenBrace| () - (PROG (G1) - (RETURN - (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '{) - (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBrace| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|brace| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|))) - (ACTION (ADVANCE-TOKEN)))))) - - -(DEFUN |PARSE-IteratorTail| () - (OR (AND (MATCH-ADVANCE-STRING "repeat") - (BANG FIL_TEST - (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|))))) - (STAR REPEATOR (|PARSE-Iterator|)))) - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 4c90552..b5066f4 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -15,39 +15,6 @@ @ \chapter{META/LISP Parser Generator and Lexical Analysis Utilities (Parsing)} -This package provides routines to support the Metalanguage -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 () @@ -1304,24 +1271,8 @@ foo defined inside of fum gets renamed as fum,foo.") (COMP (SUBLIS $OPASSOC (LIST (LIST $OP (LIST 'MLAMBDA (CONS () GARGL) $BODY))))))) -(defun DEF-INNER (FORM SIGNATURE $BODY) - "Same as DEF but assumes body has already been DEFTRANned" - (let ($OpAssoc ($op (first form)) (argl (rest form))) - (let* ((ARGL (DEF-INSERT-LET ARGL)) - (ARGLP (DEF-STRINGTOQUOTE ARGL))) - (COMP (SUBLIS $OPASSOC `((,$OP (LAM ,ARGLP ,$BODY)))))))) - (defun MKPROGN (L) (MKPF L 'PROGN)) -(defun DEF-ADDLET (X) - (if (ATOM X) - (if (STRINGP X) `(QUOTE ,(intern x)) X) - (let ((g (gensym))) - (setq $body (mkprogn - (list (def-let (comp\,fluidize x) g) - $body))) - g))) - (mapcar #'(lambda (x) (MAKEPROP (CAR X) 'RENAME (CDR X))) '((|true| 'T) (|otherwise| 'T) (|false| NIL) (|and| AND) (|or| OR) (|is| IS) @@ -1646,228 +1597,6 @@ except that elements are separated by commas." (if (ATOM l) l `(CONS ,(CAR l) ,(|newConstruct| (CDR l))))) @ -<>= - -(DEFPARAMETER |tmptok| NIL) -(DEFPARAMETER TOK NIL) -(DEFPARAMETER |ParseMode| NIL) -(DEFPARAMETER DEFINITION_NAME NIL) -(DEFPARAMETER LABLASOC NIL) - - -(DEFUN |PARSE-Suffix| () - (AND (PUSH-REDUCTION '|PARSE-Suffix| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN)) (OPTIONAL (|PARSE-TokTail|)) - (PUSH-REDUCTION '|PARSE-Suffix| - (CONS (POP-STACK-1) (CONS (POP-STACK-1) NIL))))) -(trace |PARSE-Suffix|) - - -(DEFUN |PARSE-SemiColon| () - (AND (MATCH-ADVANCE-STRING ";") - (MUST (OR (|PARSE-Expr| 82) - (PUSH-REDUCTION '|PARSE-SemiColon| '|/throwAway|))) - (PUSH-REDUCTION '|PARSE-SemiColon| - (CONS '|;| (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-SemiColon|) - - -(DEFUN |PARSE-Return| () - (AND (MATCH-ADVANCE-STRING "return") (MUST (|PARSE-Expression|)) - (PUSH-REDUCTION '|PARSE-Return| - (CONS '|return| (CONS (POP-STACK-1) NIL))))) -(trace |PARSE-Return|) - - -(DEFUN |PARSE-Exit| () - (AND (MATCH-ADVANCE-STRING "exit") - (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|))) - (PUSH-REDUCTION '|PARSE-Exit| - (CONS '|exit| (CONS (POP-STACK-1) NIL))))) -(trace |PARSE-Exit|) - - -(DEFUN |PARSE-Leave| () - (AND (MATCH-ADVANCE-STRING "leave") - (MUST (OR (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Leave| '|$NoValue|))) - (MUST (OR (AND (MATCH-ADVANCE-STRING "from") - (MUST (|PARSE-Label|)) - (PUSH-REDUCTION '|PARSE-Leave| - (CONS '|leaveFrom| - (CONS (POP-STACK-1) - (CONS (POP-STACK-1) NIL))))) - (PUSH-REDUCTION '|PARSE-Leave| - (CONS '|leave| (CONS (POP-STACK-1) NIL))))))) -(trace |PARSE-Leave|) - - -(DEFUN |PARSE-Seg| () - (AND (|PARSE-GliphTok| '|..|) - (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|))) - (PUSH-REDUCTION '|PARSE-Seg| - (CONS 'SEGMENT - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-Seg|) - - -(DEFUN |PARSE-Conditional| () - (AND (MATCH-ADVANCE-STRING "if") (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-STRING "then")) (MUST (|PARSE-Expression|)) - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "else") - (MUST (|PARSE-ElseClause|))))) - (PUSH-REDUCTION '|PARSE-Conditional| - (CONS '|if| - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))) -(trace |PARSE-Conditional|) - - -(DEFUN |PARSE-ElseClause| () - (OR (AND (EQ (CURRENT-SYMBOL) '|if|) (|PARSE-Conditional|)) - (|PARSE-Expression|))) -(trace |PARSE-ElseClause|) - - -(DEFUN |PARSE-Loop| () - (OR (AND (STAR REPEATOR (|PARSE-Iterator|)) - (MUST (MATCH-ADVANCE-STRING "repeat")) - (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| - (CONS 'REPEAT - (APPEND (POP-STACK-2) (CONS (POP-STACK-1) NIL))))) - (AND (MATCH-ADVANCE-STRING "repeat") (MUST (|PARSE-Expr| 110)) - (PUSH-REDUCTION '|PARSE-Loop| - (CONS 'REPEAT (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-Loop|) - - -(DEFUN |PARSE-Iterator| () - (OR (AND (MATCH-ADVANCE-STRING "for") (MUST (|PARSE-Primary|)) - (MUST (MATCH-ADVANCE-STRING "in")) - (MUST (|PARSE-Expression|)) - (MUST (OR (AND (MATCH-ADVANCE-STRING "by") - (MUST (|PARSE-Expr| 200)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'INBY - (CONS (POP-STACK-3) - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'IN - (CONS (POP-STACK-2) - (CONS (POP-STACK-1) NIL)))))) - (OPTIONAL - (AND (MATCH-ADVANCE-STRING "|") - (MUST (|PARSE-Expr| 111)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS '|\|| (CONS (POP-STACK-1) NIL)))))) - (AND (MATCH-ADVANCE-STRING "while") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'WHILE (CONS (POP-STACK-1) NIL)))) - (AND (MATCH-ADVANCE-STRING "until") (MUST (|PARSE-Expr| 190)) - (PUSH-REDUCTION '|PARSE-Iterator| - (CONS 'UNTIL (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-Iterator|) - - -(DEFUN |PARSE-LabelExpr| () - (AND (|PARSE-Label|) (MUST (|PARSE-Expr| 120)) - (PUSH-REDUCTION '|PARSE-LabelExpr| - (CONS 'LABEL (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-LabelExpr|) - - -(DEFUN |PARSE-FloatTok| () - (AND (PARSE-NUMBER) - (PUSH-REDUCTION '|PARSE-FloatTok| - (IF $BOOT (POP-STACK-1) (BFP- (POP-STACK-1)))))) -(trace |PARSE-FloatTok|) - - -(DEFUN |PARSE-NBGliphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) NONBLANK - (ACTION (ADVANCE-TOKEN)))) -(trace |PARSE-NBGliphTok|) - - -(DEFUN |PARSE-GliphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (MATCH-CURRENT-TOKEN 'GLIPH |tok|) (ACTION (ADVANCE-TOKEN)))) -(trace |PARSE-GliphTok|) - - -(DEFUN |PARSE-AnyId| () - (OR (PARSE-IDENTIFIER) - (OR (AND (MATCH-STRING "$") - (PUSH-REDUCTION '|PARSE-AnyId| (CURRENT-SYMBOL)) - (ACTION (ADVANCE-TOKEN))) - (PARSE-KEYWORD)))) -(trace |PARSE-AnyId|) - - -(DEFUN |PARSE-Sequence| () - (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "]"))) - (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|)) - (MUST (MATCH-ADVANCE-STRING "}")) - (PUSH-REDUCTION '|PARSE-Sequence| - (CONS '|brace| (CONS (POP-STACK-1) NIL)))))) -(trace |PARSE-Sequence|) - - -(DEFUN |PARSE-Sequence1| () - (AND (OR (AND (|PARSE-Expression|) - (PUSH-REDUCTION '|PARSE-Sequence1| - (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))) - (PUSH-REDUCTION '|PARSE-Sequence1| (CONS (POP-STACK-1) NIL))) - (OPTIONAL - (AND (|PARSE-IteratorTail|) - (PUSH-REDUCTION '|PARSE-Sequence1| - (CONS 'COLLECT - (APPEND (POP-STACK-1) - (CONS (POP-STACK-1) NIL)))))))) -(trace |PARSE-Sequence1|) - - -(DEFUN |PARSE-OpenBracket| () - (PROG (G1) - (RETURN - (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '[) - (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBracket| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|construct| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBracket| '|construct|))) - (ACTION (ADVANCE-TOKEN)))))) -(trace |PARSE-OpenBracket|) - -(DEFUN |PARSE-OpenBrace| () - (PROG (G1) - (RETURN - (AND (EQ (|getToken| (SETQ G1 (CURRENT-SYMBOL))) '{) - (MUST (OR (AND (EQCAR G1 '|elt|) - (PUSH-REDUCTION '|PARSE-OpenBrace| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|brace| NIL))))) - (PUSH-REDUCTION '|PARSE-OpenBrace| '|construct|))) - (ACTION (ADVANCE-TOKEN)))))) -(trace |PARSE-OpenBrace|) - -(DEFUN |PARSE-IteratorTail| () - (OR (AND (MATCH-ADVANCE-STRING "repeat") - (BANG FIL_TEST - (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|))))) - (STAR REPEATOR (|PARSE-Iterator|)))) -(trace |PARSE-IteratorTail|) - -@ metalex <<*>>= diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index b04c4ea..a027bb1 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -4431,7 +4431,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (b (comp-fluidize (rest x)))) (if a (cons a b) b))))) -(DEFUN COMP\,FLUIDIZE (X) (COND +(DEFUN COMPFLUIDIZE (X) (COND ((AND (IDENTP X) (NE X '$) (NE X '$$) @@ -4440,8 +4440,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ((ATOM X) X) ((EQ (QCAR X) 'FLUID) X) ('T (PROG (A B) - (SETQ A (COMP\,FLUIDIZE (QCAR X))) - (SETQ B (COMP\,FLUIDIZE (QCDR X))) + (SETQ A (COMPFLUIDIZE (QCAR X))) + (SETQ B (COMPFLUIDIZE (QCDR X))) (COND ((AND (EQ A (QCAR X)) (EQ B (QCDR X))) (RETURN X)) ('T (RETURN (CONS A B)) )) ) ))) @@ -4649,13 +4649,13 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (PROG (FT oft SFN X EDINFILE FILE DEF KEY RECNO U W SOURCEFILES SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK (/SOURCEFILES |$sourceFiles|) - METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|)) + METAKEYLST DEFINITION-NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|)) ($FUNCTION FN) $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE (*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun))) (declare (special SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES - METAKEYLST DEFINITION_NAME |$sourceFileTypes| + METAKEYLST DEFINITION-NAME |$sourceFileTypes| $FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE)) (if (PAIRP FN) (SETQ FN (QCAR FN))) @@ -4681,7 +4681,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (SETQ XCAPE (OR (GET oft '/XCAPE) #\|)) (SETQ COMMENTCHR (GET oft '/COMMENTCHR)) (SETQ XTOKENREADER (OR (GET oft '/NXTTOK) 'METATOK)) - (SETQ DEFINITION_NAME FN) + (SETQ DEFINITION-NAME FN) (SETQ KEY (STRCONC (OR (AND (EQ oFT 'SPAD) "")