aboutsummaryrefslogtreecommitdiff
path: root/src/interp/fnewmeta.lisp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 14:50:49 +0000
commit0850ca5458cb09b2d04cec162558500e9a05cf4a (patch)
treeaa76b50f08c662dab9a49b6ee9f0dc7318139ea1 /src/interp/fnewmeta.lisp
parent6f8caa148526efc14239febdc12f91165389a8ea (diff)
downloadopen-axiom-0850ca5458cb09b2d04cec162558500e9a05cf4a.tar.gz
Revert commits to the wrong tree.
Diffstat (limited to 'src/interp/fnewmeta.lisp')
-rw-r--r--src/interp/fnewmeta.lisp740
1 files changed, 0 insertions, 740 deletions
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
deleted file mode 100644
index aa0bd478..00000000
--- a/src/interp/fnewmeta.lisp
+++ /dev/null
@@ -1,740 +0,0 @@
-;; 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.
-
-
-(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|))))
-