diff options
Diffstat (limited to 'src/interp/fnewmeta.lisp.pamphlet')
| -rw-r--r-- | src/interp/fnewmeta.lisp.pamphlet | 1012 |
1 files changed, 0 insertions, 1012 deletions
diff --git a/src/interp/fnewmeta.lisp.pamphlet b/src/interp/fnewmeta.lisp.pamphlet deleted file mode 100644 index be041a6a..00000000 --- a/src/interp/fnewmeta.lisp.pamphlet +++ /dev/null @@ -1,1012 +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 -<<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>> - -(IMPORT-MODULE "parsing") -(IN-PACKAGE "BOOT" ) - - -(DEFPARAMETER |tmptok| NIL) -(DEFPARAMETER TOK NIL) -(DEFPARAMETER |ParseMode| NIL) -(DEFPARAMETER DEFINITION_NAME NIL) -(DEFPARAMETER LABLASOC NIL) - -(defun |isTokenDelimiter| () - (MEMBER (CURRENT-SYMBOL) '(\) END\_UNIT 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} |