diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-17 14:41:00 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-17 14:41:00 +0000 |
commit | 16111656afaa94a382d61de6c3ec37a9bdca05ef (patch) | |
tree | 50b54aa78118b0e723246f6acc034da705f53d35 /src/interp | |
parent | f699415cce3f73d0f2b63ecb3b1fdc7084ba4cea (diff) | |
download | open-axiom-16111656afaa94a382d61de6c3ec37a9bdca05ef.tar.gz |
* lisp/core.lisp.in: Add ref and deref to support references.
* interp/sys-constants.boot ($OperatorFunctionNames): Add "by" and
"..".
* interp/spad.lisp: Tidy.
* interp/spad-parser.boot: New parsers.
* interp/preparse.lisp: Remove dead codes.
* interp/parsing.lisp (MATCH-ADVANCE-KEYWORD): Remove.
* interp/parse.boot (doParseCategory): Rename from parseCategory.
* interp/newaux.lisp: Tidy.
* interp/lexing.boot (getSpadToken): New.
(Keywords): Remove 'when'.
(matchKeywordNext): New.
(matchSpecial): Likewise.
(matchAdvanceSpecial): Likewise.
(matchAdvanceGlyph): Likewise.
* interp/fnewmeta.lisp: Move variable definitions to preparse.lisp.
Remove Lisp based parsers.
Remove file.
* interp/c-doc.boot (recordAttributeDocumentation): Fix thinko.
* interp/bootlex.lisp (GET-BOOT-TOKEN): Remove.
* interp/Makefile.in: Adjust dependencies.
* boot/parser.boot (bpChar): New.
(bpPattern): Allow character constants.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/Makefile.in | 7 | ||||
-rw-r--r-- | src/interp/bootlex.lisp | 20 | ||||
-rw-r--r-- | src/interp/c-doc.boot | 2 | ||||
-rw-r--r-- | src/interp/fnewmeta.lisp | 627 | ||||
-rw-r--r-- | src/interp/lexing.boot | 43 | ||||
-rw-r--r-- | src/interp/newaux.lisp | 61 | ||||
-rw-r--r-- | src/interp/parse.boot | 8 | ||||
-rw-r--r-- | src/interp/parsing.lisp | 4 | ||||
-rw-r--r-- | src/interp/preparse.lisp | 25 | ||||
-rw-r--r-- | src/interp/spad-parser.boot | 604 | ||||
-rw-r--r-- | src/interp/spad.lisp | 17 | ||||
-rw-r--r-- | src/interp/sys-constants.boot | 2 |
12 files changed, 646 insertions, 774 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 2093e74e..964d7914 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -100,7 +100,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \ record.$(FASLEXT) rulesets.$(FASLEXT) \ server.$(FASLEXT) setvars.$(FASLEXT) \ sfsfun-l.$(FASLEXT) sfsfun.$(FASLEXT) \ - slam.$(FASLEXT) fnewmeta.$(FASLEXT) \ + slam.$(FASLEXT) \ preparse.$(FASLEXT) bootlex.$(FASLEXT) \ spad.$(FASLEXT) spaderror.$(FASLEXT) \ termrw.$(FASLEXT) \ @@ -322,15 +322,14 @@ server.$(FASLEXT): macros.$(FASLEXT) ## The old parser component roughtly is: ## -spad-parser.$(FASLEXT): parsing.$(FASLEXT) parse.$(FASLEXT) fnewmeta.$(FASLEXT) +spad-parser.$(FASLEXT): parse.$(FASLEXT) preparse.$(FASLEXT) parse.$(FASLEXT): parsing.$(FASLEXT) postpar.$(FASLEXT) packtran.$(FASLEXT): sys-macros.$(FASLEXT) postpar.$(FASLEXT): macros.$(FASLEXT) bootlex.$(FASLEXT): preparse.$(FASLEXT) macros.$(FASLEXT) \ nlib.$(FASLEXT) sys-globals.$(FASLEXT) newaux.$(FASLEXT): macros.$(FASLEXT) -preparse.$(FASLEXT): fnewmeta.$(FASLEXT) -fnewmeta.$(FASLEXT): parsing.$(FASLEXT) +preparse.$(FASLEXT): parsing.$(FASLEXT) parsing.$(FASLEXT): lexing.$(FASLEXT) macros.$(FASLEXT) nlib.$(FASLEXT): macros.$(FASLEXT) macros.$(FASLEXT): sys-macros.$(FASLEXT) sys-utility.$(FASLEXT) diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index b90cb4ba..93d6b997 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -154,26 +154,6 @@ ; *** 3. BOOT Token Handling *** -(defun get-BOOT-token (token) - - "If you have an _, go to the next line. -If you have a . followed by an integer, get a floating point number. -Otherwise, get a .. identifier." - - (if (not (|skipBlankChars|)) - nil - (let ((token-type (|tokenLookaheadType| (|currentChar|)))) - (case token-type - (eof (|tokenInstall| nil '*eof token |$nonblank|)) - (escape (|advanceChar!|) - (|getIdentifier| token t)) - (argument-designator (get-argument-designator-token token)) - (id (|getIdentifier| token nil)) - (num (get-spad-integer-token token)) - (string (|getSpadString| token)) - (special-char (|getSpecial| token)) - (t (|getGliph| token token-type)))))) - (defun get-argument-designator-token (token) (|advanceChar!|) (get-number-token token) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index fbf666f0..0b341a16 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -97,7 +97,7 @@ readForDoc fn == recordSignatureDocumentation(opSig,lineno) == recordDocumentation(rest postTransform opSig,lineno) -recordAttributeDocumentation(['Attribute,att],lineno) == +recordAttributeDocumentation(['%Attribute,att],lineno) == name := opOf att upperCase? stringChar(symbolName name,0) => nil recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno) diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp deleted file mode 100644 index f36d4f37..00000000 --- a/src/interp/fnewmeta.lisp +++ /dev/null @@ -1,627 +0,0 @@ -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -;; All rights reserved. -;; Copyright (C) 2007-2011, Gabriel Dos Reis. -;; 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. - -;; % 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. - -(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 (|currentSymbol|) '(\) END\_UNIT NIL))) - -(DEFUN |PARSE-SpecialCommand| () - (OR (AND (|matchAdvanceString| "show") - (BANG FIL_TEST - (OPTIONAL - (OR (|matchAdvanceString| "?") - (|PARSE-Expression|)))) - (|pushReduction| '|PARSE-SpecialCommand| - (CONS '|show| (CONS (|popStack1|) NIL))) - (MUST (|PARSE-CommandTail|))) - (AND (MEMBER (|currentSymbol|) |$noParseCommands|) - (ACTION (FUNCALL (|currentSymbol|)))) - (AND (MEMBER (|currentSymbol|) |$tokenCommands|) - (|PARSE-TokenList|) (MUST (|PARSE-TokenCommandTail|))) - (AND (STAR REPEATOR (|parsePrimaryOrQM|)) - (MUST (|PARSE-CommandTail|))))) - - -(DEFUN |PARSE-TokenList| () - (STAR REPEATOR - (AND (NOT (|isTokenDelimiter|)) - (|pushReduction| '|PARSE-TokenList| (|currentSymbol|)) - (ACTION (|advanceToken|))))) - - -(DEFUN |PARSE-TokenCommandTail| () - (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|parseTokenOption|)))) - (|atEndOfLine|) - (|pushReduction| '|PARSE-TokenCommandTail| - (CONS (|popStack2|) (APPEND (|popStack1|) NIL))) - (ACTION (|systemCommand| (|popStack1|))))) - -(DEFUN |PARSE-CommandTail| () - (AND (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Option|)))) - (|atEndOfLine|) - (|pushReduction| '|PARSE-CommandTail| - (CONS (|popStack2|) (APPEND (|popStack1|) NIL))) - (ACTION (|systemCommand| (|popStack1|))))) - -(DEFUN |PARSE-Option| () - (AND (|matchAdvanceString| ")") - (MUST (STAR REPEATOR (|parsePrimaryOrQM|))))) - - -(DEFUN |PARSE-Statement| () - (AND (|PARSE-Expr| 0) - (OPTIONAL - (AND (STAR REPEATOR - (AND (|matchAdvanceString| ",") - (MUST (|PARSE-Expr| 0)))) - (|pushReduction| '|PARSE-Statement| - (CONS '|Series| - (CONS (|popStack2|) - (APPEND (|popStack1|) NIL)))))))) - -(DEFUN |PARSE-Category| () - (PROG (G1) - (RETURN - (OR (AND (MATCH-ADVANCE-KEYWORD "if") (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-KEYWORD "then")) - (MUST (|PARSE-Category|)) - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-KEYWORD "else") - (MUST (|PARSE-Category|))))) - (|pushReduction| '|PARSE-Category| - (CONS '|if| - (CONS (|popStack3|) - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - (AND (|matchAdvanceString| "(") (MUST (|PARSE-Category|)) - (BANG FIL_TEST - (OPTIONAL - (STAR REPEATOR - (AND (|matchAdvanceString| ";") - (MUST (|PARSE-Category|)))))) - (MUST (|matchAdvanceString| ")")) - (|pushReduction| '|PARSE-Category| - (CONS 'CATEGORY - (CONS (|popStack2|) - (APPEND (|popStack1|) NIL))))) - (AND (ACTION (SETQ G1 (|lineNumber| |$spadLine|))) - (OR (|PARSE-Application|) - (|parseOperatorFunctionName|)) - (MUST (OR (AND (|matchAdvanceString| ":") - (MUST (|PARSE-Expression|)) - (|pushReduction| '|PARSE-Category| - (CONS '|%Signature| - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))) - (ACTION (|recordSignatureDocumentation| - (|nthStack| 1) G1))) - (AND (|pushReduction| '|PARSE-Category| - (CONS '|%Attribute| - (CONS (|popStack1|) NIL))) - (ACTION (|recordAttributeDocumentation| - (|nthStack| 1) G1)))))))))) - - -(DEFUN |PARSE-Expression| () - (AND (|PARSE-Expr| - (|PARSE-rightBindingPowerOf| (|makeSymbolOf| |$priorToken|) - |ParseMode|)) - (|pushReduction| '|PARSE-Expression| (|popStack1|)))) - - -(DEFUN |PARSE-Import| () - (AND (MATCH-ADVANCE-KEYWORD "import") - (MUST (|PARSE-Expr| 1000)) - (OR (AND (|matchAdvanceString| ":") - (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-KEYWORD "from")) - (MUST (|PARSE-Expr| 1000)) - (|pushReduction| '|PARSE-Import| - (CONS '|%SignatureImport| - (CONS (|popStack3|) - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - (AND (BANG FIL_TEST - (OPTIONAL - (STAR REPEATOR - (AND (|matchAdvanceString| ",") - (MUST (|PARSE-Expr| 1000)))))) - (|pushReduction| '|PARSE-Import| - (CONS '|import| - (CONS (|popStack2|) (APPEND (|popStack1|) NIL)))))))) - -;; quantified types. At the moment, these are used only in -;; pattern-mathing cases. -;; -- gdr, 2009-06-14. -(DEFUN |PARSE-Scheme| () - (OR (AND (|parseQuantifier|) - (MUST (|PARSE-QuantifiedVariableList|)) - (MUST (|matchAdvanceString| ".")) - (MUST (|PARSE-Expr| 200)) - (MUST (|pushReduction| '|PARSE-Forall| - (CONS (|popStack3|) - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - (|PARSE-Application|))) - -(DEFUN |PARSE-QuantifiedVariableList| () - (AND (|matchAdvanceString| "(") - (MUST (|parseQuantifiedVariable|)) - (OPTIONAL - (AND (STAR REPEATOR - (AND (|matchAdvanceString| ",") - (MUST (|parseQuantifiedVariable|)))) - (|pushReduction| '|PARSE-QuantifiedVariableList| - (CONS '|%Sequence| - (CONS (|popStack2|) - (APPEND (|popStack1|) NIL)))))) - (MUST (|matchAdvanceString| ")")))) - -(DEFUN |PARSE-SemiColon| () - (AND (|matchAdvanceString| ";") - (MUST (OR (|PARSE-Expr| 82) - (|pushReduction| '|PARSE-SemiColon| '|/throwAway|))) - (|pushReduction| '|PARSE-SemiColon| - (CONS '|;| (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - -(DEFUN |PARSE-Catch| () - (AND (MATCH-SPECIAL ";") - (MATCH-KEYWORD-NEXT "catch") - (ACTION (|advanceToken|)) - (ACTION (|advanceToken|)) - (MUST (|PARSE-GlyphTok| "(")) - (MUST (|parseQuantifiedVariable|)) - (MUST (MATCH-ADVANCE-SPECIAL ")")) - (MUST (|PARSE-GlyphTok| "=>")) - (MUST (|PARSE-Expression|)) - (|pushReduction| '|PARSE-Catch| - (CONS (|popStack2|) - (CONS (|popStack1|) NIL))))) - -(DEFUN |PARSE-Finally| () - (AND (MATCH-SPECIAL ";") - (MATCH-KEYWORD-NEXT "finally") - (ACTION (|advanceToken|)) - (ACTION (|advanceToken|)) - (MUST (|PARSE-Expression|)))) - -(DEFUN |PARSE-Try| () - (AND (MATCH-ADVANCE-KEYWORD "try") - (MUST (|PARSE-Expression|)) - ;; exception handlers: either a finally-expression, or - ;; a series of catch-expressions optionally followed by - ;; a finally-expression. - (MUST (OR (AND (|PARSE-Finally|) - (|pushReduction| '|PARSE-Try| - (CONS '|%Try| - (CONS (|popStack2|) - (CONS NIL - (CONS (|popStack1|) NIL)))))) - (AND (MUST (STAR REPEATOR (|PARSE-Catch|))) - (BANG FIL_TEST - (OPTIONAL (|PARSE-Finally|))) - (|pushReduction| '|PARSE-Try| - (CONS '|%Try| - (CONS (|popStack3|) - (CONS (|popStack2|) - (CONS (|popStack1|) - NIL)))))))))) - -(DEFUN |PARSE-Seg| () - (AND (|PARSE-GlyphTok| "..") - (BANG FIL_TEST (OPTIONAL (|PARSE-Expression|))) - (|pushReduction| '|PARSE-Seg| - (CONS 'SEGMENT - (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - - -(DEFUN |PARSE-Conditional| () - (AND (MATCH-ADVANCE-KEYWORD "if") (MUST (|PARSE-Expression|)) - (MUST (MATCH-ADVANCE-KEYWORD "then")) (MUST (|PARSE-Expression|)) - (BANG FIL_TEST - (OPTIONAL - (AND (MATCH-ADVANCE-KEYWORD "else") - (MUST (|parseElseClause|))))) - (|pushReduction| '|PARSE-Conditional| - (CONS '|if| - (CONS (|popStack3|) - (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) - -(DEFUN |PARSE-Loop| () - (OR (AND (STAR REPEATOR (|PARSE-Iterator|)) - (MUST (MATCH-ADVANCE-KEYWORD "repeat")) - (MUST (|PARSE-Expr| 110)) - (|pushReduction| '|PARSE-Loop| - (CONS 'REPEAT - (APPEND (|popStack2|) (CONS (|popStack1|) NIL))))) - (AND (MATCH-ADVANCE-KEYWORD "repeat") (MUST (|PARSE-Expr| 110)) - (|pushReduction| '|PARSE-Loop| - (CONS 'REPEAT (CONS (|popStack1|) NIL)))))) - - -(DEFUN |PARSE-Variable| () - (OR (AND (|parseName|) - (OPTIONAL (AND (|matchAdvanceString| ":") - (MUST (|PARSE-Application|)) - (MUST (|pushReduction| '|PARSE-Variable| - (CONS '|:| - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))))) - (|parsePrimary|))) - -(DEFUN |PARSE-Iterator| () - (OR (AND (MATCH-ADVANCE-KEYWORD "for") (MUST (|PARSE-Variable|)) - (MUST (MATCH-ADVANCE-KEYWORD "in")) - (MUST (|PARSE-Expression|)) - (MUST (OR (AND (MATCH-ADVANCE-KEYWORD "by") - (MUST (|PARSE-Expr| 200)) - (|pushReduction| '|PARSE-Iterator| - (CONS 'INBY - (CONS (|popStack3|) - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - (|pushReduction| '|PARSE-Iterator| - (CONS 'IN - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - (OPTIONAL - (AND (|matchAdvanceString| "|") - (MUST (|PARSE-Expr| 111)) - (|pushReduction| '|PARSE-Iterator| - (CONS '|\|| (CONS (|popStack1|) NIL)))))) - (AND (MATCH-ADVANCE-KEYWORD "while") (MUST (|PARSE-Expr| 190)) - (|pushReduction| '|PARSE-Iterator| - (CONS 'WHILE (CONS (|popStack1|) NIL)))) - (AND (MATCH-ADVANCE-KEYWORD "until") (MUST (|PARSE-Expr| 190)) - (|pushReduction| '|PARSE-Iterator| - (CONS 'UNTIL (CONS (|popStack1|) NIL)))))) - - -(DEFUN |PARSE-Match| () - (AND (MATCH-ADVANCE-KEYWORD "case") - (MUST (|PARSE-Expr| 400)) - (MATCH-ADVANCE-KEYWORD "is") - (MUST (|PARSE-Expr| 110)) - (|pushReduction| '|PARSE-Match| - (CONS '|%Match| - (CONS (|popStack2|) - (CONS (|popStack1|) NIL)))))) - -(DEFUN |PARSE-Expr| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (|PARSE-NudPart| RBP) - (OPTIONAL (STAR OPT_EXPR (|PARSE-LedPart| RBP))) - (|pushReduction| '|PARSE-Expr| (|popStack1|)))) - -(DEFUN |PARSE-LedPart| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (|PARSE-Operation| '|Led| RBP) - (|pushReduction| '|PARSE-LedPart| (|popStack1|)))) - - -(DEFUN |PARSE-NudPart| (RBP) - (DECLARE (SPECIAL RBP)) - (AND (OR (|PARSE-Operation| '|Nud| RBP) (|PARSE-Reduction|) - (|PARSE-Form|)) - (|pushReduction| '|PARSE-NudPart| (|popStack1|)))) - - -(DEFUN |PARSE-Operation| (|ParseMode| RBP) - (DECLARE (SPECIAL |ParseMode| RBP)) - (AND (NOT (|matchCurrentToken| 'IDENTIFIER)) - (GETL (SETQ |tmptok| (|currentSymbol|)) |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|) (|parsePrefix|)) - (AND (EQ IND '|Led|) (|parseInfix|)))) - - -(DEFUN |PARSE-Reduction| () - (AND (|PARSE-ReductionOp|) (MUST (|PARSE-Expr| 1000)) - (|pushReduction| '|PARSE-Reduction| - (CONS '|%Reduce| - (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - - -(DEFUN |PARSE-ReductionOp| () - (AND (GETL (|currentSymbol|) '|Led|) - (|matchNextToken| 'GLIPH '/) - (|pushReduction| '|PARSE-ReductionOp| (|currentSymbol|)) - (ACTION (|advanceToken|)) (ACTION (|advanceToken|)))) - - -(DEFUN |PARSE-Form| () - (OR (AND (MATCH-ADVANCE-KEYWORD "iterate") - (|pushReduction| '|PARSE-Form| (CONS '|iterate| NIL))) - (AND (MATCH-ADVANCE-KEYWORD "yield") (MUST (|PARSE-Application|)) - (|pushReduction| '|PARSE-Form| - (CONS '|yield| (CONS (|popStack1|) NIL)))) - (|PARSE-Application|))) - - -(DEFUN |PARSE-Application| () - (AND (|parsePrimary|) (OPTIONAL (STAR OPT_EXPR (|PARSE-Selector|))) - (OPTIONAL - (AND (|PARSE-Application|) - (|pushReduction| '|PARSE-Application| - (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) - - -(DEFUN |PARSE-Selector| () - (OR (AND |$nonblank| (EQ (|currentSymbol|) '|.|) - (CHAR-NE (|currentChar|) '| |) (|matchAdvanceString| ".") - (MUST (|PARSE-PrimaryNoFloat|)) - (MUST (|pushReduction| '|PARSE-Selector| - (CONS (|popStack2|) (CONS (|popStack1|) NIL))))) - (AND (OR (|PARSE-Float|) - (AND (|matchAdvanceString| ".") - (MUST (|parsePrimary|)))) - (MUST (|pushReduction| '|PARSE-Selector| - (CONS (|popStack2|) (CONS (|popStack1|) NIL))))))) - - -(DEFUN |PARSE-PrimaryNoFloat| () - (AND (|PARSE-Primary1|) (OPTIONAL (|parseTokenTail|)))) - -(DEFUN |PARSE-Primary1| () - (OR (AND (|parseName|) - (OPTIONAL - (AND |$nonblank| (EQ (|currentSymbol|) '|(|) - (MUST (|PARSE-Primary1|)) - (|pushReduction| '|PARSE-Primary1| - (CONS (|popStack2|) (CONS (|popStack1|) NIL)))))) - (|parseQuad|) (|parseString|) (|parseInteger|) - (|parseFormalParameter|) - (AND (|matchAdvanceString| "'") - (MUST (AND (MUST (|PARSE-Data|)) - (|pushReduction| '|PARSE-Primary1| (|popStack1|))))) - (|PARSE-Sequence|) (|PARSE-Enclosure|))) - - -(DEFUN |PARSE-Float| () - (AND (|PARSE-FloatBase|) - (MUST (OR (AND |$nonblank| (|PARSE-FloatExponent|)) - (|pushReduction| '|PARSE-Float| 0))) - (|pushReduction| '|PARSE-Float| - (MAKE-FLOAT (|popStack4|) (|popStack2|) (|popStack2|) - (|popStack1|))))) - - -(DEFUN |PARSE-FloatBase| () - (OR (AND (INTEGERP (|currentSymbol|)) (CHAR-EQ (|currentChar|) ".") - (CHAR-NE (|nextChar|) ".") (|parseInteger|) - (MUST (|PARSE-FloatBasePart|))) - (AND (INTEGERP (|currentSymbol|)) - (CHAR-EQ (CHAR-UPCASE (|currentChar|)) 'E) - (|parseInteger|) (|pushReduction| '|PARSE-FloatBase| 0) - (|pushReduction| '|PARSE-FloatBase| 0)) - (AND (DIGITP (|currentChar|)) (EQ (|currentSymbol|) '|.|) - (|pushReduction| '|PARSE-FloatBase| 0) - (|PARSE-FloatBasePart|)))) - - -(DEFUN |PARSE-FloatBasePart| () - (AND (|matchAdvanceString| ".") - (MUST (OR (AND (DIGITP (|currentChar|)) - (|pushReduction| '|PARSE-FloatBasePart| - (|tokenNonblank?| (|currentToken|))) - (|parseInteger|)) - (AND (|pushReduction| '|PARSE-FloatBasePart| 0) - (|pushReduction| '|PARSE-FloatBasePart| 0)))))) - - -(DEFUN |PARSE-FloatExponent| () - (PROG (G1) - (RETURN - (OR (AND (MEMBER (|currentSymbol|) '(E |e|)) - (FIND (|currentChar|) "+-") (ACTION (|advanceToken|)) - (MUST (OR (|parseInteger|) - (AND (|matchAdvanceString| "+") - (MUST (|parseInteger|))) - (AND (|matchAdvanceString| "-") - (MUST (|parseInteger|)) - (|pushReduction| '|PARSE-FloatExponent| - (MINUS (|popStack1|)))) - (|pushReduction| '|PARSE-FloatExponent| 0)))) - (AND (IDENTP (|currentSymbol|)) - (SETQ G1 (FLOATEXPID (|currentSymbol|))) - (ACTION (|advanceToken|)) - (|pushReduction| '|PARSE-FloatExponent| G1)))))) - - -(DEFUN |PARSE-Enclosure| () - (OR (AND (|matchAdvanceString| "(") - (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (|matchAdvanceString| ")"))) - (AND (|matchAdvanceString| ")") - (|pushReduction| '|PARSE-Enclosure| - (CONS '|%Comma| NIL)))))) - (AND (|matchAdvanceString| "{") - (MUST (OR (AND (|PARSE-Expr| 6) - (MUST (|matchAdvanceString| "}")) - (|pushReduction| '|PARSE-Enclosure| - (CONS '|brace| - (CONS - (CONS '|construct| - (CONS (|popStack1|) NIL)) - NIL)))) - (AND (|matchAdvanceString| "}") - (|pushReduction| '|PARSE-Enclosure| - (CONS '|brace| NIL)))))) - (AND (|matchAdvanceString| "[|") - (MUST (AND (|PARSE-Statement|) - (MUST (|matchAdvanceString| "|]")) - (|pushReduction| '|PARSE-Enclosure| - (CONS '|[\|\|]| - (CONS (|popStack1|) NIL))) - ))) - )) - -(DEFUN |PARSE-Data| () - (AND (ACTION (SETQ LABLASOC NIL)) (|PARSE-Sexpr|) - (|pushReduction| '|PARSE-Data| - (CONS 'QUOTE (CONS (TRANSLABEL (|popStack1|) LABLASOC) NIL))))) - - -(DEFUN |PARSE-Sexpr| () - (AND (ACTION (|advanceToken|)) (|PARSE-Sexpr1|))) - - -(DEFUN |PARSE-Sexpr1| () - (OR (|parseInteger|) - (|parseString|) - (AND (|parseAnyId|) - (OPTIONAL - (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|)) - (ACTION (SETQ LABLASOC - (CONS (CONS (|popStack2|) - (|nthStack| 1)) - LABLASOC)))))) - (AND (|matchAdvanceString| "'") (MUST (|PARSE-Sexpr1|)) - (|pushReduction| '|PARSE-Sexpr1| - (CONS 'QUOTE (CONS (|popStack1|) NIL)))) - ;; next form disabled -- gdr, 2009-06-15. -; (AND (|matchAdvanceString| "-") (MUST (|parseInteger|)) -; (|pushReduction| '|PARSE-Sexpr1| (MINUS (|popStack1|)))) - (AND (|matchAdvanceString| "[") - (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|)))) - (MUST (|matchAdvanceString| "]")) - (|pushReduction| '|PARSE-Sexpr1| (LIST2VEC (|popStack1|)))) - (AND (|matchAdvanceString| "(") - (BANG FIL_TEST - (OPTIONAL - (AND (STAR REPEATOR (|PARSE-Sexpr1|)) - (OPTIONAL - (AND (|PARSE-GlyphTok| ".") - (MUST (|PARSE-Sexpr1|)) - (|pushReduction| '|PARSE-Sexpr1| - (|append!| (|popStack2|) (|popStack1|)))))))) - (MUST (|matchAdvanceString| ")"))))) - - -(DEFUN |PARSE-NBGliphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (|matchCurrentToken| 'GLIPH |tok|) |$nonblank| - (ACTION (|advanceToken|)))) - - -(DEFUN |PARSE-GlyphTok| (|tok|) - (DECLARE (SPECIAL |tok|)) - (AND (|matchCurrentToken| 'GLIPH (INTERN |tok|)) - (ACTION (|advanceToken|)))) - -(DEFUN |PARSE-Sequence| () - (OR (AND (|PARSE-OpenBracket|) (MUST (|PARSE-Sequence1|)) - (MUST (|matchAdvanceString| "]"))) - (AND (|PARSE-OpenBrace|) (MUST (|PARSE-Sequence1|)) - (MUST (|matchAdvanceString| "}")) - (|pushReduction| '|PARSE-Sequence| - (CONS '|brace| (CONS (|popStack1|) NIL)))))) - - -(DEFUN |PARSE-Sequence1| () - (AND (OR (AND (|PARSE-Expression|) - (|pushReduction| '|PARSE-Sequence1| - (CONS (|popStack2|) (CONS (|popStack1|) NIL)))) - (|pushReduction| '|PARSE-Sequence1| (CONS (|popStack1|) NIL))) - (OPTIONAL - (AND (|PARSE-IteratorTail|) - (|pushReduction| '|PARSE-Sequence1| - (CONS 'COLLECT - (APPEND (|popStack1|) - (CONS (|popStack1|) NIL)))))))) - - -(DEFUN |PARSE-OpenBracket| () - (LET ((G1 (|currentSymbol|))) - (AND (EQ (|getToken| G1) '[) - (MUST (OR (AND (EQCAR G1 '|elt|) - (|pushReduction| '|PARSE-OpenBracket| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|construct| NIL))))) - (|pushReduction| '|PARSE-OpenBracket| '|construct|))) - (ACTION (|advanceToken|))))) - - -(DEFUN |PARSE-OpenBrace| () - (LET ((G1 (|currentSymbol|))) - (AND (EQ (|getToken| G1) '{) - (MUST (OR (AND (EQCAR G1 '|elt|) - (|pushReduction| '|PARSE-OpenBrace| - (CONS '|elt| - (CONS (CADR G1) - (CONS '|brace| NIL))))) - (|pushReduction| '|PARSE-OpenBrace| '|construct|))) - (ACTION (|advanceToken|))))) - - -(DEFUN |PARSE-IteratorTail| () - (OR (AND (MATCH-ADVANCE-KEYWORD "repeat") - (BANG FIL_TEST - (OPTIONAL (STAR REPEATOR (|PARSE-Iterator|))))) - (STAR REPEATOR (|PARSE-Iterator|)))) - diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot index d0f1c065..325aa513 100644 --- a/src/interp/lexing.boot +++ b/src/interp/lexing.boot @@ -188,8 +188,22 @@ tokenInstall(sym,typ,tok,nonblank == true) == tokenNonblank?(tok) := nonblank tok +getSpadToken tok == + not skipBlankChars() => nil + tt := tokenLookaheadType currentChar() + tt is 'EOF => tokenInstall(nil,'_*EOF,tok,$nonblank) + tt is 'ESCAPE => + advanceChar!() + getIdentifier(tok,true) + tt is 'ARGUMENT_-DESIGNATOR => GET_-ARGUMENT_-DESIGNATOR_-TOKEN tok + tt is 'ID => getIdentifier(tok,false) + tt is 'NUM => GET_-SPAD_-INTEGER_-TOKEN tok + tt is 'STRING => getSpadString tok + tt is 'SPECIAL_-CHAR => getSpecial tok + getGliph(tok,tt) + tryGetToken tok == - GET_-BOOT_-TOKEN tok => + getSpadToken tok => $validTokens := $validTokens + 1 tok nil @@ -205,9 +219,10 @@ nextToken() == $validTokens > 1 => $nextToken tryGetToken $nextToken -matchToken(tok,typ,sym == false) == +matchToken(tok,typ,sym == nil) == tok ~= nil and symbolEq?(tokenType tok,typ) and - (sym = nil or symbolEq?(sym,tokenSymbol tok)) and tok + (sym = nil or sym = tokenSymbol tok) => tok + nil ++ Return the current token if it has type `typ', and possibly the ++ same spelling as `sym'. @@ -299,10 +314,10 @@ getGliph(tok,gliphs) == gliphs := rest gliphs advanceChar!() s := makeSymbol listToString reverse! buf - return tokenInstall(property(s,'RENAMETOK) or s,'GLIPH,tok,$nonblank) + return tokenInstall(s,'GLIPH,tok,$nonblank) Keywords == [ - "or", "and", "isnt", "is", "when", "where", "forall", "exist", "try", + "or", "and", "isnt", "is", "where", "forall", "exist", "try", "has", "with", "add", "case", "in", "by", "pretend", "mod", "finally", "exquo", "div", "quo", "else", "rem", "then", "suchthat", "catch", "throw", "if", "iterate", "break", "from", "exit", "leave", "return", @@ -409,6 +424,24 @@ matchAdvanceKeyword kwd == true false +matchKeywordNext kwd == + matchToken(nextToken(),'KEYWORD,kwd) + +matchSpecial c == + matchToken(currentToken(),'SPECIAL_-CHAR,c) + +matchAdvanceSpecial c == + matchSpecial c => + advanceToken() + true + false + +matchAdvanceGlyph s == + matchToken(currentToken(),'GLIPH,s) => + advanceToken() + true + false + --% --% Stack abstract datatype. --% Operational semantics: diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp index 555c489c..3d668367 100644 --- a/src/interp/newaux.lisp +++ b/src/interp/newaux.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2009, Gabriel Dos Reis. +;; Copyright (C) 2007-2011, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -40,7 +40,6 @@ ; ; 1. Led and Nud Tables ; 2. GLIPH Table -; 3. RENAMETOK Table ; 4. GENERIC Table ; 5. Character syntax class predicates @@ -106,7 +105,7 @@ (\@ 996 997) (|pretend| 995 996) (\.) (\! \! 1002 1001) (\, 110 111) - (\; 81 82 (|PARSE-SemiColon|)) + (\; 81 82 (|parseSemicolon|)) (< 400 400) (> 400 400) (<< 400 400) (>> 400 400) (<= 400 400) (>= 400 400) @@ -122,7 +121,7 @@ (|is| 400 400) (|isnt| 400 400) (|and| 250 251) (|or| 200 201) (/\\ 250 251) (\\/ 200 201) - (\.\. SEGMENT 401 699 (|PARSE-Seg|)) + (\.\. SEGMENT 401 699 (|parseSegmentTail|)) (=> 123 103) (+-> 998 121) (== DEF 122 121) @@ -131,14 +130,14 @@ (\:- LETD 125 124) (\:= %LET 125 124))) (mapcar #'(LAMBDA (J) (MAKENEWOP J `|Nud|)) - '((|for| 130 350 (|PARSE-Loop|)) - (|while| 130 190 (|PARSE-Loop|)) - (|until| 130 190 (|PARSE-Loop|)) - (|repeat| 130 190 (|PARSE-Loop|)) - (|import| 120 0 (|PARSE-Import|) ) + '((|for| 130 350 (|parseLoop|)) + (|while| 130 190 (|parseLoop|)) + (|until| 130 190 (|parseLoop|)) + (|repeat| 130 190 (|parseLoop|)) + (|import| 120 0 (|parseImport|) ) (|inline| 120 0 (|parseInline|) ) - (|forall| 998 999 (|PARSE-Scheme|)) - (|exist| 998 999 (|PARSE-Scheme|)) + (|forall| 998 999 (|parseScheme|)) + (|exist| 998 999 (|parseScheme|)) (|unless|) (|add| 900 120) (|with| 1000 300 (|parseWith|)) @@ -147,14 +146,14 @@ ;; (\+ 701 700) (\# 999 998) (\! 1002 1001) - (\' 999 999 (|PARSE-Data|)) + (\' 999 999 (|parseData|)) (-> 1001 1002) (\: 194 195) (|not| 260 259 NIL) (~ 260 259 nil) (= 400 700) (|return| 202 201 (|parseReturn|)) - (|try| 202 201 (|PARSE-Try|)) + (|try| 202 201 (|parseTry|)) (|throw| 202 201 (|parseThrow|)) (|leave| 202 201 (|parseLeave|)) (|exit| 202 201 (|parseExit|)) @@ -162,45 +161,13 @@ (|iterate| 202 201 (|parseJump|)) (|from|) (|yield|) - (|if| 130 0 (|PARSE-Conditional|)) ; was 130 - (|case| 130 190 (|PARSE-Match|)) + (|if| 130 0 (|parseConditional|)) ; was 130 + (|case| 130 190 (|parseMatch|)) (\| 0 190) (|suchthat|) (|then| 0 114) (|else| 0 114))) - -;; Gliphs are symbol clumps. The gliph property of a symbol gives -;; the tree describing the tokens which begin with that symbol. -;; The token reader uses the gliph property to determine the longest token. -;; Thus `:=' is read as one token not as `:' followed by `='. - -(mapcar #'(lambda (x) (makeprop (car x) 'gliph (cdr x))) - `( - ( \| (\)) (]) ) - ( * (*) ) - ( \( (\|) ) - ( + (- (>)) ) - ( - (>) ) - ( < (=) (<) ) - ( / (\\) ) - ( \\ (/) ) - ( > (=) (>) ) - ( = (= (>)) (>) ) - ( \. (\.) ) - ( ^ (=) ) - ( \~ (=) ) - ( [ (\|) ) - ( \: (=) (-) (\:)))) - -;; GENERIC operators be suffixed by `$' qualifications in SPAD code. -;; `$' is then followed by a domain label, such as I for Integer, which -;; signifies which domain the operator refers to. For example `+$Integer' -;; is `+' for Integers. - -(mapcar #'(lambda (x) (MAKEPROP X 'GENERIC 'TRUE)) - '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ~= )) - (defun SPECIALCASESYNTAX () (OR (AND (char= TOK '#\#) (DIGITP CHR)))) (defun TERMINATOR (CHR) diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 1af246df..9f30064d 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -237,9 +237,9 @@ parseTranCheckForRecord(x,op) == x x -parseCategory: %ParseForm -> %Form -parseCategory t == - t isnt ["CATEGORY",:x] => systemErrorHere ["parseCategory",t] +doParseCategory: %ParseForm -> %Form +doParseCategory t == + t isnt ["CATEGORY",:x] => systemErrorHere ["doParseCategory",t] $parsingType: local := true l := parseTranList x key := @@ -445,7 +445,7 @@ for x in [[":", :"parseColon"],_ ["::", :"parseCoerce"],_ ["@", :"parseAtSign"],_ ["and", :"parseAnd"],_ - ["CATEGORY", :"parseCategory"],_ + ["CATEGORY", :"doParseCategory"],_ ["construct", :"parseConstruct"],_ ["DEF", :"parseDEF"],_ ["exit", :"doParseExit"],_ diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index 668bf1e3..ce5a2826 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -295,10 +295,6 @@ the stack, then stack a NIL. Return the value of prod." ; (3) Line handling: Next Line, Print Next Line ; (X) Random Stuff -(defun match-advance-keyword (str) - (and (|matchToken| (|currentToken|) 'keyword (intern str)) - (action (|advanceToken|)))) - (defun match-advance-special (str) (and (|matchToken| (|currentToken|) 'special-char (character str)) (action (|advanceToken|)))) diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp index 47acccb4..aff89033 100644 --- a/src/interp/preparse.lisp +++ b/src/interp/preparse.lisp @@ -57,7 +57,7 @@ -(IMPORT-MODULE "fnewmeta") +(IMPORT-MODULE "parsing") (in-package "BOOT") @@ -70,29 +70,14 @@ (defparameter $EchoLineStack nil "Stack of lines to list.") (defparameter $IOIndex 0 "Number of latest terminal input line.") +(DEFPARAMETER TOK NIL) +(DEFPARAMETER DEFINITION_NAME NIL) +(DEFPARAMETER LABLASOC NIL) + (defun Initialize-Preparse (strm) (setq $INDEX 0 $LineList nil $EchoLineStack nil) (setq $preparse-last-line (get-a-line strm))) -(defmacro pptest () `(/rp ">scratchpad>test.boot")) - -(defun /RP (&optional (*boot-input-file* nil) (*boot-output-file* nil) - ($preparseReportIfTrue t)) - (with-open-stream - (in-stream (or (and *boot-input-file* - (open *boot-input-file* :direction :input)) - |$InputStream|)) - (declare (special in-stream)) - (with-open-stream - (out-stream (if *boot-output-file* - (open *boot-output-file* :direction :output) - |$OutputStream|)) - (declare (special out-stream)) - (initialize-preparse in-stream) - (do ((lines (PREPARSE in-stream) (PREPARSE in-stream))) ((null lines))))) - T) - - (defvar $skipme) (defun PREPARSE (Strm &aux (stack ())) diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index a7780674..43e04256 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -42,15 +42,26 @@ -- -- gdr/2007-11-02 -- -import parsing +import preparse import parse -import fnewmeta namespace BOOT --% macro compulsorySyntax s == s or SPAD__SYNTAX__ERROR() +repeatedSyntax(l,p) == + n := stackSize $reduceStack + once := false + while apply(p,nil) repeat + once := true + not once => nil + x := nil + for i in (n+1)..stackSize $reduceStack repeat + x := [popStack1(),:x] + x = nil => true + pushReduction(l,x) + --% parseToken tt == @@ -60,14 +71,77 @@ parseToken tt == true false +parseGlyph s == + matchCurrentToken('GLIPH,s) => + advanceToken() + true + false + +parseNBGlyph tok == + matchCurrentToken('GLIPH,tok) and $nonblank => + advanceToken() + true + false + parseString() == parseToken 'SPADSTRING parseInteger() == parseToken 'NUMBER +parseFloatBasePart() == + matchAdvanceGlyph "." => + $nonblank and (t := matchCurrentToken 'NUMBER) => + t := copyToken t + advanceToken() + pushReduction('parseFloatBasePart,tokenNonblank? t) + pushReduction('parseFloatBasePart,tokenSymbol t) + pushReduction('parseFloatBasePart,0) + pushReduction('parseFloatBasePart,0) + nil + +parseFloatBase() == + integer? currentSymbol() and currentChar() = char "." and + nextChar() ~= char "." and parseInteger() => + compulsorySyntax parseFloatBasePart() + integer? currentSymbol() and charUpcase currentChar() = char "E" + and parseInteger() => + pushReduction('parseBase,0) + pushReduction('parseBase,0) + digit? currentChar() and currentSymbol() is "." => + pushReduction('parseBase,0) + pushReduction('parseBase,0) + nil + +parseFloatExponent() == + not ident? currentSymbol() => nil + symbolMember?(currentSymbol(),'(e E)) and + charMember?(currentChar(),[char "+",char "-"]) => + advanceToken() + parseInteger() => true + matchAdvanceGlyph "+" => compulsorySyntax parseInteger() + matchAdvanceGlyph "-" => + compulsorySyntax parseInteger() + pushReduction('parseFloatExponent,-popStack1()) + pushReduction('parseFloatExponent,0) + g := FLOATEXPID currentSymbol() => + advanceToken() + pushReduction('parseFloatExponent,g) + nil + +parseFloat() == + parseFloatBase() => + $nonblank and parseFloatExponent() + or pushReduction('parseFloat,0) + pushReduction('parseFloat, + MAKE_-FLOAT(popStack4(),popStack2(),popStack2(),popStack1())) + nil + parseName() == parseToken 'IDENTIFIER and pushReduction('parseName,popStack1()) + +parseKeyword() == + parseToken 'KEYWORD and pushReduction('parseKeyword,popStack1()) parseFormalParameter() == parseToken 'ARGUMENT_-DESIGNATOR @@ -84,6 +158,7 @@ parseOperatorFunctionName() == parseAnyId() == parseName() => true + parseKeyword() => true matchString '"$" => pushReduction('parseAnyId,currentSymbol()) advanceToken() @@ -93,8 +168,26 @@ parseAnyId() == parseQuad() == matchAdvanceString '"$" and pushReduction('parseQuad,"$") +parsePrimary1() == + parseName() => + $nonblank and currentSymbol() is "(" => + compulsorySyntax parsePrimary1() + pushReduction('parsePrimary1,[popStack2(),popStack1()]) + true + parseQuad() or parseString() or parseInteger() or + parseFormalParameter() => true + matchSpecial char "'" => + compulsorySyntax parseData() + pushReduction('parsePrimary1,popStack1()) + parseSequence() or parseEnclosure() + +parsePrimaryNoFloat() == + parsePrimary1() => + parseTokenTail() or true + false + parsePrimary() == - PARSE_-Float() or PARSE_-PrimaryNoFloat() + parseFloat() or parsePrimaryNoFloat() parsePrimaryOrQM() == matchAdvanceString '"?" => pushReduction('parsePrimaryOrQM,"?") @@ -105,8 +198,46 @@ parseSpecialKeyWord() == tokenSymbol(currentToken()) := unAbbreviateKeyword currentSymbol() nil +parseSexpr1() == + parseInteger() or parseString() => true + parseAnyId() => + parseNBGlyph "=" => + compulsorySyntax parseSexpr1() + SETQ(LABLASOC,[[popStack2(),:nthStack 1],:LABLASOC]) + true + true + matchAdvanceSpecial char "'" => + compulsorySyntax parseSexpr1() + pushReduction('parseSexpr1,["QUOTE",popStack1()]) + matchAdvanceGlyph "[" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1) + if not stackUpdated? $reduceStack then + pushReduction('parseSexpr1,nil) + compulsorySyntax matchAdvanceGlyph "]" + pushReduction('parseSexpr1,LIST2VEC popStack1()) + matchAdvanceGlyph "(" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1) + if parseGlyph "." then + compulsorySyntax parseSexpr1() + pushReduction('parseSexpr1,append!(popStack2(),popStack1())) + if not stackUpdated? $reduceStack then + pushReduction('parseSexpr1,nil) + compulsorySyntax matchAdvanceGlyph ")" + nil + +parseSexpr() == + advanceToken() + parseSexpr1() + +parseData() == + SETQ(LABLASOC,nil) + parseSexpr() and + pushReduction('parseData,["QUOTE",TRANSLABEL(popStack1(),LABLASOC)]) + parseCommand() == - matchAdvanceString '")" => + matchAdvanceString '")" => --FIXME: remove matchAdvanceString compulsorySyntax parseSpecialKeyWord() compulsorySyntax parseSpecialCommand() pushReduction('parseStatement,nil) @@ -117,7 +248,7 @@ parseTokenOption() == parseQualification() == matchAdvanceString '"$" => - compulsorySyntax PARSE_-Primary1() + compulsorySyntax parsePrimary1() pushReduction('parseQualification,dollarTran(popStack1(),popStack1())) nil @@ -130,23 +261,137 @@ parseTokenTail() == $priorToken := tok nil +parseSelector() == + $nonblank and currentSymbol() is "." and currentChar() ~= char " " + and matchAdvanceGlyph "." => + compulsorySyntax parsePrimaryNoFloat() + pushReduction('parseSelector,[popStack2(),popStack1()]) + parseFloat() + or matchAdvanceGlyph "." and compulsorySyntax parsePrimary() => + pushReduction('parseSelector,[popStack2(),popStack1()]) + nil + +parseApplication() == + parsePrimary() => + repeatedSyntax('selectors,function parseSelector) + parseApplication() and + pushReduction('parseApplication,[popStack2(),popStack1()]) + true + nil + +parseOperation($ParseMode,rbp) == + matchCurrentToken 'IDENTIFIER => nil + s := currentSymbol() + not symbol? s or property(s,$ParseMode) = nil => nil + rbp >= parseLeftBindingPowerOf(s,$ParseMode) => nil + parseGetSemanticForm(s,$ParseMode,ELEMN(property(s,$ParseMode),5,nil)) + +parseLedPart rbp == + parseOperation('Led,rbp) and + pushReduction('parseLedPart,popStack1()) + +parseNudPart rbp == + parseOperation('Nud,rbp) or parseReduction() or parseForm() => + pushReduction('parseNudPart,popStack1()) + +parseExpr rbp == + parseNudPart rbp => + repeatedSyntax('parseExpr,function(() +-> parseLedPart rbp)) + pushReduction('parseExpr,popStack1()) + nil + parseInfix() == pushReduction('parseInfix,currentSymbol()) advanceToken() parseTokenTail() - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseInfix,[popStack2(),popStack2(),popStack1()]) parsePrefix() == pushReduction('parsePrefix,currentSymbol()) advanceToken() parseTokenTail() - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parsePrefix,[popStack2(),popStack1()]) +parseLeftBindingPowerOf(x,p) == + y := property(x,p) => ELEMN(y,3,0) + 0 + +parseRightBindingPowerOf(x,p) == + y := property(x,p) => ELEMN(y,4,105) + 105 + +parseGetSemanticForm(x,p,y) == + z := EVAL y => z -- FIXME get rid of EVAL. + p = "Nud" => parsePrefix() + p = "Led" => parseInfix() + nil + +parseExpression() == + parseExpr parseRightBindingPowerOf(makeSymbolOf $priorToken,$ParseMode) + and pushReduction('parseExpression,popStack1()) + +parseSegmentTail() == + parseGlyph ".." => + stackUpdated?($reduceStack) := false + parseExpression() + if not stackUpdated? $reduceStack then + pushReduction('segmentTail,nil) + pushReduction('parseSegmentTail,["SEGMENT",popStack2(),popStack1()]) + nil + +parseReductionOp() == + s := currentSymbol() + if string? s then + s := makeSymbol s -- FIXME: abolish string-quoted operators + ident? s and property(s,'Led) and matchNextToken('GLIPH,"/") => + pushReduction('parseReductionOp,s) + advanceToken() + advanceToken() + true + false + +parseReduction() == + parseReductionOp() => + compulsorySyntax parseExpr 1000 + pushReduction('parseReduction,["%Reduce",popStack2(),popStack1()]) + nil + +parseCategory() == + matchAdvanceKeyword "if" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "then" + compulsorySyntax parseCategory() + stackUpdated?($reduceStack) := false + matchAdvanceKeyword "else" and compulsorySyntax parseCategory() + if not stackUpdated? $reduceStack then + pushReduction('alternateCategory,nil) + pushReduction('parseCategory,["if",popStack3(),popStack2(),popStack1()]) + matchAdvanceGlyph "(" => + compulsorySyntax parseCategory() + stackUpdated?($reduceStack) := false + repeatedSyntax('unnamedCategory,function(() +-> + matchAdvanceSpecial char ";" and compulsorySyntax parseCategory())) + if not stackUpdated? $reduceStack then + pushReduction('unnamedCategory,nil) + compulsorySyntax matchAdvanceSpecial char ")" + pushReduction('parseCategory,["CATEGORY",popStack2(),:popStack1()]) + g := lineNumber $spadLine + parseApplication() or parseOperatorFunctionName() => + matchAdvanceGlyph ":" => + compulsorySyntax parseExpression() + pushReduction('parseCategory,["%Signature",popStack2(),popStack1()]) + recordSignatureDocumentation(nthStack 1,g) + true + pushReduction('parseCategory,["%Attribute",popStack1()]) + recordAttributeDocumentation(nthStack 1,g) + true + nil + parseWith() == matchAdvanceKeyword "with" => - compulsorySyntax PARSE_-Category() + compulsorySyntax parseCategory() pushReduction('parseWith,["with",popStack1()]) nil @@ -155,17 +400,8 @@ parseInfixWith() == pushReduction('parseInfixWith,["Join",popStack2(),popStack1()]) parseElseClause() == - currentSymbol() is "if" => PARSE_-Conditional() - PARSE_-Expression() - -++ domain inlining. Same syntax as import directive; except -++ deliberate restriction on naming one type at a time. -++ -- gdr, 2009-02-28. -parseInline() == - matchAdvanceKeyword "inline" => - compulsorySyntax PARSE_-Expr 1000 - pushReduction('parseInline,["%Inline",popStack1()]) - nil + currentSymbol() is "if" => parseConditional() + parseExpression() parseQuantifier() == matchAdvanceKeyword "forall" => @@ -176,28 +412,68 @@ parseQuantifier() == parseQuantifiedVariable() == parseName() => - compulsorySyntax matchAdvanceString '":" - compulsorySyntax PARSE_-Application() + compulsorySyntax matchAdvanceGlyph ":" + compulsorySyntax parseApplication() pushReduction('parseQuantifiedVariable,[":",popStack2(),popStack1()]) nil +parseQuantifiedVariableList() == + matchAdvanceGlyph "(" => + compulsorySyntax parseQuantifiedVariable() + repeatedSyntax('repeatedVars,function(() +-> + matchAdvanceSpecial char "," and parseQuantifiedVariable())) + and pushReduction('parseQuantifiedVariableList, + ["%Sequence",popStack2(),:popStack1()]) + compulsorySyntax matchAdvanceSpecial char ")" + nil + +++ quantified types. At the moment, these are used only in +++ pattern-mathing cases. +++ -- gdr, 2009-06-14. +parseScheme() == + parseQuantifier() => + compulsorySyntax parseQuantifiedVariableList() + compulsorySyntax matchAdvanceGlyph "." + compulsorySyntax parseExpr 200 + pushReduction('parseScheme,[popStack3(),popStack2(),popStack1()]) + parseApplication() + +parseConditional() == + matchAdvanceKeyword "if" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "then" + compulsorySyntax parseExpression() + stackUpdated?($reduceStack) := false + if matchAdvanceKeyword "else" then + parseElseClause() + if not stackUpdated? $reduceStack then + pushReduction('elseBranch,nil) + pushReduction('parseConditional,["if",popStack3(),popStack2(),popStack1()]) + nil + +parseSemicolon() == + matchAdvanceSpecial char ";" => + parseExpr 82 or pushReduction('parseSemicolon,"/throwAway") + pushReduction('parseSemicolon,[";",popStack2(),popStack1()]) + nil + ++ We should factorize these boilerplates parseReturn() == matchAdvanceKeyword "return" => - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseReturn,["return",popStack1()]) nil parseThrow() == matchAdvanceKeyword "throw" => - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseReturn,["%Throw",popStack1()]) nil parseExit() == matchAdvanceKeyword "exit" => x := - PARSE_-Expression() => popStack1() + parseExpression() => popStack1() "$NoValue" pushReduction('parseExit,["exit",x]) nil @@ -205,7 +481,7 @@ parseExit() == parseLeave() == matchAdvanceKeyword "leave" => x := - PARSE_-Expression() => popStack1() + parseExpression() => popStack1() "$NoValue" pushReduction('parseLeave,["leave",x]) nil @@ -216,12 +492,256 @@ parseJump() == pushReduction('parseJump,s) nil +parseForm() == + matchAdvanceKeyword "iterate" => + pushReduction('parseForm,["iterate"]) + matchAdvanceKeyword "yield" => + compulsorySyntax parseApplication() + pushReduction('parseForm,["yield",popStack1()]) + parseApplication() + +parseVariable() == + parseName() => + matchAdvanceGlyph ":" => + compulsorySyntax parseApplication() + pushReduction('parseVariable,[":",popStack2(),popStack1()]) + true + parsePrimary() + +parseIterator() == + matchAdvanceKeyword "for" => + compulsorySyntax parseVariable() + compulsorySyntax matchAdvanceKeyword "in" + compulsorySyntax parseExpression() + matchAdvanceKeyword "by" and compulsorySyntax parseExpr 200 and + pushReduction('parseIterator,["INBY",popStack3(),popStack2(),popStack1()]) + or pushReduction('parseIterator,["IN",popStack2(),popStack1()]) + matchAdvanceGlyph "|" and compulsorySyntax parseExpr 111 and + pushReduction('parseIterator,["|",popStack1()]) + true + matchAdvanceKeyword "while" => + compulsorySyntax parseExpr 190 + pushReduction('parseIterator,["WHILE",popStack1()]) + matchAdvanceKeyword "until" => + compulsorySyntax parseExpr 190 + pushReduction('parseIterator,["UNTIL",popStack1()]) + nil + +parseIteratorTails() == + matchAdvanceKeyword "repeat" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseIteratorTails,function parseIterator) + if not stackUpdated? $reduceStack then + pushReduction('crossIterators,nil) + repeatedSyntax('parseIteratorTails,function parseIterator) + +parseLoop() == + repeatedSyntax('iterators,function parseIterator) => + compulsorySyntax matchAdvanceKeyword "repeat" + compulsorySyntax parseExpr 110 + pushReduction('parseLoop,["REPEAT",:popStack2(),popStack1()]) + matchAdvanceKeyword "repeat" => + compulsorySyntax parseExpr 110 + pushReduction('parseLoop,["REPEAT",popStack1()]) + nil + +parseOpenBracket() == + s := currentSymbol() + getToken s is "[" => + do + s is ["elt",:.] => + pushReduction('parseOpenBracket,["elt",second s,"construct"]) + pushReduction('parseOpenBracket,"construct") + advanceToken() + true + false + +parseOpenBrace() == + s := currentSymbol() + getToken s is "{" => + do + s is ["elt",:.] => + pushReduction('parseOpenBracket,["elt",second s,"brace"]) + pushReduction('parseOpenBracket,"construct") --FIXME: should be brace + advanceToken() + true + false + +parseSequence1() == + do + parseExpression() => + pushReduction('parseSequence1,[popStack2(),popStack1()]) + pushReduction('parseSequence1,[popStack1()]) + parseIteratorTails() and + pushReduction('parseSequence1,["COLLECT",:popStack1(),popStack1()]) + true + +parseSequence() == + parseOpenBracket() => + compulsorySyntax parseSequence1() + compulsorySyntax matchAdvanceSpecial char "]" + parseOpenBrace() => + compulsorySyntax parseSequence1() + compulsorySyntax matchAdvanceSpecial char "}" + pushReduction('parseSequence,["brace",popStack1()]) + nil + +parseEnclosure() == + matchAdvanceGlyph "(" => + parseExpr 6 => + compulsorySyntax matchAdvanceSpecial char ")" + matchAdvanceSpecial char ")" => + pushReduction('parseEnclosure,["%Comma"]) + SPAD__SYNTAX__ERROR() + matchAdvanceGlyph "{" => + parseExpr 6 => + compulsorySyntax matchAdvanceSpecial char "}" + pushReduction('parseEnclosure,["brace",["construct",popStack1()]]) + matchAdvanceSpecial char "}" => + pushReduction('parseEnclosure,["brace"]) + SPAD__SYNTAX__ERROR() + matchAdvanceGlyph "[|" => + parseStatement() => + compulsorySyntax matchAdvanceGlyph "|]" + pushReduction('parseEnclosure,["[||]",popStack1()]) + SPAD__SYNTAX__ERROR() + nil + +parseCatch() == + matchSpecial char ";" and matchKeywordNext "catch" => + advanceToken() + advanceToken() + compulsorySyntax parseGlyph "(" + compulsorySyntax parseQuantifiedVariable() + compulsorySyntax matchAdvanceSpecial char ")" + compulsorySyntax parseGlyph "=>" + compulsorySyntax parseExpression() + pushReduction('parseCatch,[popStack2(),popStack1()]) + nil + +parseFinally() == + matchSpecial char ";" and matchKeywordNext "finally" => + advanceToken() + advanceToken() + compulsorySyntax parseExpression() + nil + +parseTry() == + matchAdvanceKeyword "try" => + compulsorySyntax parseExpression() + -- exception handlers: either a finally-expression, or + -- a series of catch-expressions optionally followed by + -- a finally-expression. + parseFinally() => + pushReduction('parseTry,["%Try",popStack2(),nil,popStack1()]) + compulsorySyntax repeatedSyntax('handlers,function parseCatch) => + stackUpdated?($reduceStack) := false + parseFinally() + if not stackUpdated? $reduceStack then + pushReduction('finalizer,nil) + pushReduction('parseTry,["%Try",popStack3(),popStack2(),popStack1()]) + SPAD__SYNTAX__ERROR() + nil + +parseMatch() == + matchAdvanceKeyword "case" => + compulsorySyntax parseExpr 400 + compulsorySyntax matchAdvanceKeyword "is" + compulsorySyntax parseExpr 110 + pushReduction('parseMatch,["%Match",popStack2(),popStack1()]) + nil + +++ domain inlining. Same syntax as import directive; except +++ deliberate restriction on naming one type at a time. +++ -- gdr, 2009-02-28. +parseInline() == + matchAdvanceKeyword "inline" => + compulsorySyntax parseExpr 1000 + pushReduction('parseInline,["%Inline",popStack1()]) + nil + +parseImport() == + matchAdvanceKeyword "import" => + compulsorySyntax parseExpr 1000 + matchAdvanceGlyph ":" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "from" + compulsorySyntax parseExpr 1000 + pushReduction('parseImport, + ["%SignatureImport",popStack3(),popStack2(),popStack1()]) + stackUpdated?($reduceStack) := false + repeatedSyntax('imports,function(() +-> matchAdvanceSpecial char "," + and compulsorySyntax parseExpr 1000)) + if not stackUpdated? $reduceStack then + pushReduction('imports,nil) + pushReduction('parseImport,["import",popStack2(),:popStack1()]) + nil + +parseStatement() == + parseExpr 0 => + repeatedSyntax('statements,function(() +-> matchAdvanceGlyph "," + and compulsorySyntax parseExpr 0)) => + pushReduction('parseStatement,["Series",popStack2(),:popStack1()]) + true + false + parseNewExpr() == matchString '")" => processSynonyms() compulsorySyntax parseCommand() SETQ(DEFINITION__NAME,currentSymbol()) - PARSE_-Statement() + parseStatement() + +--% + +isTokenDelimiter() == + symbolMember?(currentSymbol(),[")","END__UNIT","NIL"]) + +parseTokenList() == + repeatedSyntax('tokenList,function(() +-> + (isTokenDelimiter() => nil; pushReduction('parseTokenList,currentSymbol()); + advanceToken(); true))) + +parseCommandTail() == + stackUpdated?($reduceStack) := false + repeatedSyntax('options,function parseTokenOption) + if not stackUpdated? $reduceStack then + pushReduction('options,nil) + atEndOfLine() and + pushReduction('parseCommandTail,[popStack2(),:popStack1()]) + systemCommand popStack1() + true + +parseOption() == + matchAdvanceString '")" => --FIXME: kill matchAdvanceString + compulsorySyntax repeatedSyntax('options,function parsePrimaryOrQM) + +parseTokenCommandTail() == + stackUpdated?($reduceStack) := false + repeatedSyntax('options,function parseOption) + if not stackUpdated? $reduceStack then + pushReduction('options,nil) + atEndOfLine() and + pushReduction('parseCommandTail,[popStack2(),:popStack1()]) + systemCommand popStack1() + true + +parseSpecialCommand() == + matchAdvanceString '"show" => --FIXME: kill matchAdvanceString + stackUpdated?($reduceStack) := true + repeatedSyntax('commands,function(() +-> matchAdvanceString '"?" + or parseExpression())) + if not stackUpdated? $reduceStack then + pushReduction('commdnds,nil) + pushReduction('parseSpecialCommand,["show",popStack1()]) + compulsorySyntax parseCommandTail() + symbolMember?(currentSymbol(),$noParseCommands) => + apply(currentSymbol(),nil) + true + symbolMember?(currentSymbol(),$tokenCommands) and parseTokenList() => + compulsorySyntax parseTokenCommandTail() + repeatedSyntax('parseSpecialCommand,function parsePrimaryOrQM) and + compulsorySyntax parseCommandTail() --% @@ -267,3 +787,35 @@ parseSpadFile sourceFile == -- we accumulated the parse trees in reverse order reverse! asts +--% + +++ Gliphs are symbol clumps. The gliph property of a symbol gives +++ the tree describing the tokens which begin with that symbol. +++ The token reader uses the gliph property to determine the longest token. +++ Thus `:=' is read as one token not as `:' followed by `='. +for x in [ + ["|", [")"], ["]"]],_ + ["*", ["*"]],_ + ["(", ["|"]],_ + ["+", ["-", [">"]]],_ + ["-", [">"]],_ + ["<", ["="], ["<"]], + ["/", ["\"]],_ + ["\", ["/"]],_ + [">", ["="], [">"]],_ + ["=", ["=", [">"]] ,[">"]],_ + [".", ["."]],_ + ["^", ["="]],_ + ["~", ["="]],_ + ["[", ["|"]],_ + [":", ["="], ["-"], [":"]]_ + ] repeat + property(first x,'GLIPH) := rest x + +++ Generic infix operators +for x in ["-", "=", "*", "rem", "mod", "quo", "div", "/", "^", + "**", "exquo", "+", "-", "<", ">", "<=", ">=", "~=", + "and", "or", "/\", "\/", "<<", ">>"] _ + repeat + property(x,'GENERIC) := true + diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index 2b883cae..fc517d67 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -42,7 +42,6 @@ ;;; Common Block -(defvar |$preserveSystemLisplib| t "if nil finalizeLisplib does MA REP") (defvar |$reportInstantiations| nil) (defvar |$reportEachInstantiation| nil) (defvar |$reportCounts| nil) @@ -55,13 +54,10 @@ (defvar |$algebraFormat| t "produce 2-d algebra output") (defvar |$HiFiAccess| nil "if true maintain history file") -(defvar |boot-NewKEY| NIL) - (DEFVAR _ '&) (defvar /EDIT-FM 'A1) (defvar /EDIT-FT 'SPAD) (defvar /RELEASE '"UNKNOWN") -(defvar /rp '/RP) (defvar error-print) (defvar ind) (defvar INITCOLUMN 0) @@ -69,18 +65,14 @@ (defvar m-chrbuffer) (defvar m-chrindex) (defvar MARG 0 "Margin for testing by ?OP") -(defvar NewFlag) -(defvar ParseMode) (defvar RLGENSYMFG NIL) (defvar RLGENSYMLST NIL) (defvar S-SPADTOK 'SPADSYSTOK) (defvar sortpred) (defvar SPADSYSKEY '(EOI EOL)) (defvar STAKCOLUMN -1) -(defvar xtrans '|boot-new|) (defvar |$IOAlist| '((|%i| . (|gauss| 0 1)))) (defvar |InteractiveMode|) -(defvar |NewFLAG| t) (defvar |uc| 'UC) (DEFUN INTEGER-BIT (N I) (LOGBITP I N)) @@ -181,7 +173,6 @@ (COND (Q (/RQ)) ('T (/RF)) ) - (FLAG |boot-NewKEY| 'KEY) (|terminateSystemCommand|)) (defun /EDIT (L) @@ -263,17 +254,14 @@ (S-PROCESS x)))) (defun |New,ENTRY,1| () - (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| + (let (ZZ str N RLGENSYMFG RLGENSYMLST SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT) - $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS + $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM STACK STACKX TRAPFLAG) - (SETQ XTRANS '|boot-New|) - (FLAG |boot-NewKEY| 'KEY) (PROMPT) (SETQ COMMENTCHR 'IGNORE) (SETQ INITCOLUMN 0) (SETQ SINGLELINEMODE T) ; SEE NewSYSTOK - (SETQ NewFLAG T) (SETQ ULCASEFG T) (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| |$InputStream|)) (if (/= 0 (setq N (NOTE STR))) @@ -286,7 +274,6 @@ (INITIALIZE) (SETQ |$previousTime| (TEMPUS-FUGIT)) (setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|)) - (REMFLAG |boot-NewKEY| 'KEY) INPUTSTREAM)) (defun INITIALIZE () diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index 2aefc81d..8349e810 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -700,7 +700,7 @@ $defaultOptimizationLevel == 2 $OperatorFunctionNames == ["**", "^", "*", "/", "rem", "quo", "mod", "div", "exquo", "+", "-", ">", ">=", "=", "~=", "<", "<=", "#", "~", "not", - "case", "and", "or", "<<", ">>", "/\", "\/" ] + "case", "and", "or", "<<", ">>", "/\", "\/", "..", "by" ] --% %categoryKind == 'category |