diff options
author | dos-reis <gdr@axiomatics.org> | 2012-05-24 03:23:59 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2012-05-24 03:23:59 +0000 |
commit | fbcb9ebe438100f7a549329ae14668cd27fde508 (patch) | |
tree | ea4ac9322ecca78bc976418a33677cf8ec88b6d0 /src/boot | |
parent | 698aa5abf97234248cf7f59216759d9cc0d2290b (diff) | |
download | open-axiom-fbcb9ebe438100f7a549329ae14668cd27fde508.tar.gz |
* boot/tokens.boot: "@" is now a new keyword.
* boot/ast.boot (bfRestrict): New.
(bpTyped): Rename from bpTagged. Accept type restriction.
* boot/utility.boot (drop): Restrict the result to a %List.
Diffstat (limited to 'src/boot')
-rw-r--r-- | src/boot/ast.boot | 4 | ||||
-rw-r--r-- | src/boot/parser.boot | 18 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 80 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 16 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 19 | ||||
-rw-r--r-- | src/boot/strap/utility.clisp | 15 | ||||
-rw-r--r-- | src/boot/tokens.boot | 1 | ||||
-rw-r--r-- | src/boot/utility.boot | 5 |
8 files changed, 90 insertions, 68 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 54d9b7ed..3d21b6f7 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -74,6 +74,7 @@ structure %Ast == %EqualPattern(%Ast) -- =x -- patterns %Colon(%Symbol) -- :x %QualifiedName(%Symbol,%Symbol) -- m::x + %Restrict(%Ast,%Ast) -- x@t %DefaultValue(%Symbol,%Ast) -- opt. value for function param. %Key(%Symbol,%Ast) -- k <- x %Bracket(%Ast) -- [x, y] @@ -1146,6 +1147,9 @@ bfTagged(a,b)== a ["THE",b,a] +bfRestrict(x,t) == + ["THE",t,x] + bfAssign(l,r)== bfTupleP l => bfSetelt(second l,CDDR l ,r) l is ["%Place",:l'] => ["SETF",l',r] diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 414f21ca..a830a7d9 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -626,14 +626,20 @@ bpTyping() == bpPush %Forall(bpPop2(), bpPop1()) bpMapping() or bpSimpleMapping() -++ Tagged: -++ Name : Typing -bpTagged()== +++ Typed: +++ Application : Typing +++ Application @ Typing +bpTyped()== bpApplication() and - (bpEqKey "COLON" and bpRequire function bpTyping and - bpPush bfTagged(bpPop2(),bpPop1()) or true) + bpEqKey "COLON" => + bpRequire function bpTyping and + bpPush bfTagged(bpPop2(),bpPop1()) + bpEqKey "AT" => + bpRequire function bpTyping and + bpPush bfRestrict(bpPop2(), bpPop1()) + true -bpExpt()== bpRightAssoc('(POWER),function bpTagged) +bpExpt()== bpRightAssoc('(POWER),function bpTyped) bpInfKey s == tokenClass $stok = "KEY" and diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 89380ea0..249192fa 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -55,91 +55,93 @@ (DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|) (CONS '|%QualifiedName| (LIST . #1#))) -(DEFUN |%DefaultValue| #1=(|bfVar#29| |bfVar#30|) +(DEFUN |%Restrict| #1=(|bfVar#29| |bfVar#30|) (CONS '|%Restrict| (LIST . #1#))) + +(DEFUN |%DefaultValue| #1=(|bfVar#31| |bfVar#32|) (CONS '|%DefaultValue| (LIST . #1#))) -(DEFUN |%Key| #1=(|bfVar#31| |bfVar#32|) (CONS '|%Key| (LIST . #1#))) +(DEFUN |%Key| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Key| (LIST . #1#))) -(DEFUN |%Bracket| #1=(|bfVar#33|) (CONS '|%Bracket| (LIST . #1#))) +(DEFUN |%Bracket| #1=(|bfVar#35|) (CONS '|%Bracket| (LIST . #1#))) -(DEFUN |%UnboundedSegment| #1=(|bfVar#34|) +(DEFUN |%UnboundedSegment| #1=(|bfVar#36|) (CONS '|%UnboundedSegment| (LIST . #1#))) -(DEFUN |%BoundedSgement| #1=(|bfVar#35| |bfVar#36|) +(DEFUN |%BoundedSgement| #1=(|bfVar#37| |bfVar#38|) (CONS '|%BoundedSgement| (LIST . #1#))) -(DEFUN |%Tuple| #1=(|bfVar#37|) (CONS '|%Tuple| (LIST . #1#))) +(DEFUN |%Tuple| #1=(|bfVar#39|) (CONS '|%Tuple| (LIST . #1#))) -(DEFUN |%ColonAppend| #1=(|bfVar#38| |bfVar#39|) +(DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|) (CONS '|%ColonAppend| (LIST . #1#))) -(DEFUN |%Pretend| #1=(|bfVar#40| |bfVar#41|) (CONS '|%Pretend| (LIST . #1#))) +(DEFUN |%Pretend| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Pretend| (LIST . #1#))) -(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#))) +(DEFUN |%Is| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Is| (LIST . #1#))) -(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#))) +(DEFUN |%Isnt| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Isnt| (LIST . #1#))) -(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#))) +(DEFUN |%Reduce| #1=(|bfVar#48| |bfVar#49|) (CONS '|%Reduce| (LIST . #1#))) -(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|) +(DEFUN |%PrefixExpr| #1=(|bfVar#50| |bfVar#51|) (CONS '|%PrefixExpr| (LIST . #1#))) -(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#))) +(DEFUN |%Call| #1=(|bfVar#52| |bfVar#53|) (CONS '|%Call| (LIST . #1#))) -(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|) +(DEFUN |%InfixExpr| #1=(|bfVar#54| |bfVar#55| |bfVar#56|) (CONS '|%InfixExpr| (LIST . #1#))) -(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|) +(DEFUN |%ConstantDefinition| #1=(|bfVar#57| |bfVar#58|) (CONS '|%ConstantDefinition| (LIST . #1#))) -(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|) +(DEFUN |%Definition| #1=(|bfVar#59| |bfVar#60| |bfVar#61|) (CONS '|%Definition| (LIST . #1#))) -(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|) +(DEFUN |%Macro| #1=(|bfVar#62| |bfVar#63| |bfVar#64|) (CONS '|%Macro| (LIST . #1#))) -(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#))) +(DEFUN |%Lambda| #1=(|bfVar#65| |bfVar#66|) (CONS '|%Lambda| (LIST . #1#))) -(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#))) +(DEFUN |%SuchThat| #1=(|bfVar#67|) (CONS '|%SuchThat| (LIST . #1#))) -(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|) +(DEFUN |%Assignment| #1=(|bfVar#68| |bfVar#69|) (CONS '|%Assignment| (LIST . #1#))) -(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#))) +(DEFUN |%While| #1=(|bfVar#70|) (CONS '|%While| (LIST . #1#))) -(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#))) +(DEFUN |%Until| #1=(|bfVar#71|) (CONS '|%Until| (LIST . #1#))) -(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#))) +(DEFUN |%For| #1=(|bfVar#72| |bfVar#73| |bfVar#74|) (CONS '|%For| (LIST . #1#))) -(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#))) +(DEFUN |%Implies| #1=(|bfVar#75| |bfVar#76|) (CONS '|%Implies| (LIST . #1#))) -(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#))) +(DEFUN |%Iterators| #1=(|bfVar#77|) (CONS '|%Iterators| (LIST . #1#))) -(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#))) +(DEFUN |%Cross| #1=(|bfVar#78|) (CONS '|%Cross| (LIST . #1#))) -(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#))) +(DEFUN |%Repeat| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Repeat| (LIST . #1#))) -(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#))) +(DEFUN |%Pile| #1=(|bfVar#81|) (CONS '|%Pile| (LIST . #1#))) -(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#))) +(DEFUN |%Append| #1=(|bfVar#82|) (CONS '|%Append| (LIST . #1#))) -(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#))) +(DEFUN |%Case| #1=(|bfVar#83| |bfVar#84|) (CONS '|%Case| (LIST . #1#))) -(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#))) +(DEFUN |%Return| #1=(|bfVar#85|) (CONS '|%Return| (LIST . #1#))) -(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#))) +(DEFUN |%Leave| #1=(|bfVar#86|) (CONS '|%Leave| (LIST . #1#))) -(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#))) +(DEFUN |%Throw| #1=(|bfVar#87|) (CONS '|%Throw| (LIST . #1#))) -(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#))) +(DEFUN |%Catch| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Catch| (LIST . #1#))) -(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#))) +(DEFUN |%Finally| #1=(|bfVar#90|) (CONS '|%Finally| (LIST . #1#))) -(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#))) +(DEFUN |%Try| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Try| (LIST . #1#))) -(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#))) +(DEFUN |%Where| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Where| (LIST . #1#))) -(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|) +(DEFUN |%Structure| #1=(|bfVar#95| |bfVar#96|) (CONS '|%Structure| (LIST . #1#))) (DEFPARAMETER |$inDefIS| NIL) @@ -2075,6 +2077,8 @@ |a|))) (T (LIST 'THE |b| |a|)))) +(DEFUN |bfRestrict| (|x| |t|) (LIST 'THE |t| |x|)) + (DEFUN |bfAssign| (|l| |r|) (LET* (|l'|) (COND ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 53eb4f53..e4862eb5 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -585,14 +585,18 @@ (|bpPush| (|%Forall| (|bpPop2|) (|bpPop1|)))) (T (OR (|bpMapping|) (|bpSimpleMapping|))))) -(DEFUN |bpTagged| () +(DEFUN |bpTyped| () (AND (|bpApplication|) - (OR - (AND (|bpEqKey| 'COLON) (|bpRequire| #'|bpTyping|) - (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|)))) - T))) + (COND + ((|bpEqKey| 'COLON) + (AND (|bpRequire| #'|bpTyping|) + (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))) + ((|bpEqKey| 'AT) + (AND (|bpRequire| #'|bpTyping|) + (|bpPush| (|bfRestrict| (|bpPop2|) (|bpPop1|))))) + (T T)))) -(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTagged|)) +(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTyped|)) (DEFUN |bpInfKey| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index abb77212..34e00c36 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -54,15 +54,16 @@ (LIST "then" 'THEN) (LIST "throw" 'THROW) (LIST "try" 'TRY) (LIST "until" 'UNTIL) (LIST "with" 'WITH) (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT) (LIST ":" 'COLON) - (LIST "::" 'COLON-COLON) (LIST "," 'COMMA) (LIST ";" 'SEMICOLON) - (LIST "*" 'TIMES) (LIST "**" 'POWER) (LIST "/" 'SLASH) (LIST "+" 'PLUS) - (LIST "-" 'MINUS) (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) - (LIST ">=" 'GE) (LIST "=" 'SHOEEQ) (LIST "~=" 'SHOENE) (LIST ".." 'SEG) - (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST "->" 'ARROW) - (LIST "<-" 'LARROW) (LIST ":=" 'BEC) (LIST "+->" 'GIVES) - (LIST "==" 'DEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) - (LIST ")" 'CPAREN) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) - (LIST "'" 'QUOTE) (LIST "|" 'BAR))) + (LIST "::" 'COLON-COLON) (LIST "@" 'AT) (LIST "," 'COMMA) + (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER) + (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS) (LIST "<" 'LT) + (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE) (LIST "=" 'SHOEEQ) + (LIST "~=" 'SHOENE) (LIST ".." 'SEG) (LIST "#" 'LENGTH) + (LIST "=>" 'EXIT) (LIST "->" 'ARROW) (LIST "<-" 'LARROW) + (LIST ":=" 'BEC) (LIST "+->" 'GIVES) (LIST "==" 'DEF) + (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) + (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "'" 'QUOTE) + (LIST "|" 'BAR))) (DEFUN |shoeKeyTableCons| () (LET* (|KeyTable|) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 80244b61..4de1d345 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -165,12 +165,15 @@ (DEFUN |drop| (|n| |l|) (COND ((NOT (MINUSP |n|)) - (LOOP - (COND - ((NOT (AND (PLUSP |n|) (CONSP |l|) (PROGN (SETQ |l| (CDR |l|)) T))) - (RETURN NIL)) - (T (SETQ |n| (- |n| 1))))) - |l|) + (LET ((|bfVar#1| 1)) + (LOOP + (COND + ((OR (> |bfVar#1| |n|) + (NOT (AND (CONSP |l|) (PROGN (SETQ |l| (CDR |l|)) T)))) + (RETURN NIL)) + (T NIL)) + (SETQ |bfVar#1| (+ |bfVar#1| 1)))) + (THE (|%List| |%Thing|) |l|)) (T (|take| (+ (LENGTH |l|) |n|) |l|)))) (DEFUN |copyTree| (|t|) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index ac4d665a..7b0c786f 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -110,6 +110,7 @@ shoeKeyWords == [ _ ['".", "DOT"], _ ['":", "COLON"], _ ['"::", "COLON-COLON"], _ + ['"@", "AT" ], _ ['",", "COMMA"], _ ['";", "SEMICOLON"], _ ['"*", "TIMES"], _ diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 294f9d71..42bbbf00 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -107,9 +107,8 @@ takeWhile(f,l) == ++ If `n' is negative, drop from the end. drop(n,l) == n >= 0 => - while n > 0 and l is [.,:l] repeat - n := n - 1 - l + for . in 1..n while l is [.,:l] repeat nil + l@%List(%Thing) take(#l+n,l) copyTree t == |