diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 262 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 8 |
3 files changed, 13 insertions, 263 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index ea16334c..ae58e0db 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2010-05-17 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/fnewmeta.lisp: Remove out-of-date META grammar. + (PARSE-LabelExpr): Remove. + * interp/newaux.lisp: Remove Nud property for << and >>. + 2010-05-16 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/as.boot: Clean up. diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index 7df80102..e575c8af 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.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-2010, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -31,256 +31,12 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;; % 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 (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 +(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 "GLIPH "/)) % 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 +(#2 #1) -;; / (Float /'.' Primary) +(#2 #1); - -;; PrimaryNoFloat: Primary1 <TokTail> ; - -;; Primary: Float /PrimaryNoFloat ; - -;; Primary1: VarForm <=(AND NONBLANK (EQ (CURRENT-SYMBOL) "\()) Primary1 +(#2 #1)> -;; /Quad -;; /String -;; /IntegerTok -;; /FormalParameter -;; /='\'' ('\'' 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 +=(BFP- #1) ; - -;; FormalParameter: FormalParameterTok ; - -;; FormalParameterTok: ARGUMENT-DESIGNATOR ; - -;; Quad: '$' +\$ ; - -;; 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 ; - - - (IMPORT-MODULE "parsing") (IN-PACKAGE "BOOT" ) @@ -590,14 +346,8 @@ (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))))))) + (MUST (PUSH-REDUCTION '|PARSE-Leave| + (CONS '|leave| (CONS (POP-STACK-1) NIL)))))) (DEFUN |PARSE-Seg| () @@ -683,12 +433,6 @@ (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 ">>")))) diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp index ddf763b1..ed9b0030 100644 --- a/src/interp/newaux.lisp +++ b/src/interp/newaux.lisp @@ -112,8 +112,10 @@ (<= 400 400) (>= 400 400) (= 400 400) (^= 400 400) (~= 400 400) - (|in| 400 400) (|case| 400 400) - (|add| 400 120) (|with| 2000 400 (|PARSE-InfixWith|)) + (|in| 400 400) + (|case| 400 400) + (|add| 400 120) + (|with| 2000 400 (|PARSE-InfixWith|)) (|has| 400 400) (|where| 121 104) ; must be 121 for SPAD, 126 for boot--> nboot (|when| 112 190) @@ -146,8 +148,6 @@ (\# 999 998) (\! 1002 1001) (\' 999 999 (|PARSE-Data|)) - (<< 122 120 (|PARSE-LabelExpr|)) - (>>) (-> 1001 1002) (\: 194 195) (|not| 260 259 NIL) |