diff options
Diffstat (limited to 'src/interp/fnewmeta.lisp.pamphlet')
| -rw-r--r-- | src/interp/fnewmeta.lisp.pamphlet | 1008 |
1 files changed, 1008 insertions, 0 deletions
diff --git a/src/interp/fnewmeta.lisp.pamphlet b/src/interp/fnewmeta.lisp.pamphlet new file mode 100644 index 00000000..29c55dd3 --- /dev/null +++ b/src/interp/fnewmeta.lisp.pamphlet @@ -0,0 +1,1008 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp fnewmeta.lisp} +\author{William Burge} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<fnew.meta>>= +% 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: + <TokenOption*>! ?(atEndOfLine) +(#2 -#1) .(systemCommand #1) ; + +TokenOption: ')' TokenList ; + +CommandTail: <Option*>! ?(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) <TokTail> + Expression +(#2 #2 #1) ; + +Prefix: =TRUE +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail> + Expression +(#2 #1) ; + +Suffix: +=(CURRENT-SYMBOL) .(ADVANCE-TOKEN) <TokTail> +(#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{"\.\.} <Expression>! +(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} <LedPart{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 <Operator Left-Power Right-Power>, and the same for a Nud, except that +% it may also have a fourth component <Special-Handler>. 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>* <Application +(#2 #1)>; + +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 <TokTail> ; + +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 <Scripts +(Scripts #2 #1) > +#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 + / '<' <Sexpr1*>! '>' +=(LIST2VEC #1) + / '(' <Sexpr1* <GliphTok{"\.} Sexpr1 +=(NCONC #2 #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)) <IteratorTail +(COLLECT -#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*>! / Iterator*) ; + +.FIN ; + + +@ +\section{License} +<<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. + +@ +<<*>>= +<<license>> + +(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 (FIXP (CURRENT-SYMBOL)) (CHAR-EQ (CURRENT-CHAR) ".") + (CHAR-NE (NEXT-CHAR) ".") (|PARSE-IntegerTok|) + (MUST (|PARSE-FloatBasePart|))) + (AND (FIXP (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} |