From b6e44a931b9e95fb4253eeeb048f167e55375937 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 28 Dec 2011 13:02:02 +0000 Subject: * interp/vmlisp.lisp (SORTBY): Remove. (QSORT): Likewise. * interp/c-util.boot (formal?): Rename from isFormal. Avoid POSITION. * interp/sys-utility.boot (sortBy): New. * interp/br-op1.boot: Use it. * interp/clam.boot: Likewise. * interp/define.boot: Likewise. * interp/i-output.boot: Likewise. * interp/i-coerfn.boot: Likewise. * interp/i-syscmd.boot: Likewise. * interp/showimp.boot: Likewise. * boot/tokens.boot: "<-" is now a token. * boot/ast.boot (bfKeyArg): New. (bfExpandKeys): Likewise. (bfApplication): Use it. * boot/parser.boot (bpKeyArg): New. (bpAssign): Use it. Parse named arguments. --- src/boot/ast.boot | 14 +++++- src/boot/parser.boot | 7 +++ src/boot/strap/ast.clisp | 106 ++++++++++++++++++++++++++++---------------- src/boot/strap/parser.clisp | 5 +++ src/boot/strap/tokens.clisp | 8 ++-- src/boot/tokens.boot | 1 + 6 files changed, 99 insertions(+), 42 deletions(-) (limited to 'src/boot') diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 4a476189..656fdceb 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -72,6 +72,7 @@ structure %Ast == %Colon(%Symbol) -- :x %QualifiedName(%Symbol,%Symbol) -- m::x %DefaultValue(%Symbol,%Ast) -- opt. value for function param. + %Key(%Symbol,%Ast) -- k <- x %Bracket(%Ast) -- [x, y] %UnboundedSegment(%Ast) -- 3.. %BoundedSgement(%Ast,%Ast) -- 2..4 @@ -770,8 +771,19 @@ bfHas(expr,prop) == symbol? prop => ["GET",expr, quote prop] bpSpecificErrorHere('"expected identifier as property name") +bfKeyArg(k,x) == + ['%Key,k,x] + +bfExpandKeys l == + args := nil + while l is [a,:l] repeat + a is ['%Key,k,x] => + args := [x,makeSymbol(stringUpcase symbolName k,'"KEYWORD"),:args] + args := [a,:args] + reverse! args + bfApplication(bfop, bfarg) == - bfTupleP bfarg => [bfop,:rest bfarg] + bfTupleP bfarg => [bfop,:bfExpandKeys rest bfarg] [bfop,bfarg] -- returns the meaning of x in the appropriate Boot dialect. diff --git a/src/boot/parser.boot b/src/boot/parser.boot index dde2bd3e..5c198129 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -858,6 +858,9 @@ bpAssign()== bpEqPeek "GIVES" => bpRestore a bpLambda() or bpTrap() + bpEqPeek "LARROW" => + bpRestore a + bpKeyArg() or bpTrap() true bpRestore a false @@ -876,6 +879,10 @@ bpLambda() == (bpAssign() or bpTrap()) and bpPush bfLambda(bpPop2(),bpPop1()) +bpKeyArg() == + bpName() and bpEqKey "LARROW" and bpLogical() and + bpPush bfKeyArg(bpPop2(),bpPop1()) + -- should only be allowed in sequences bpExit()== bpAssign() and (bpEqKey "EXIT" and diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 3bf3ce53..b0c40086 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -51,86 +51,88 @@ (DEFUN |%DefaultValue| #1=(|bfVar#24| |bfVar#25|) (CONS '|%DefaultValue| (LIST . #1#))) -(DEFUN |%Bracket| #1=(|bfVar#26|) (CONS '|%Bracket| (LIST . #1#))) +(DEFUN |%Key| #1=(|bfVar#26| |bfVar#27|) (CONS '|%Key| (LIST . #1#))) -(DEFUN |%UnboundedSegment| #1=(|bfVar#27|) +(DEFUN |%Bracket| #1=(|bfVar#28|) (CONS '|%Bracket| (LIST . #1#))) + +(DEFUN |%UnboundedSegment| #1=(|bfVar#29|) (CONS '|%UnboundedSegment| (LIST . #1#))) -(DEFUN |%BoundedSgement| #1=(|bfVar#28| |bfVar#29|) +(DEFUN |%BoundedSgement| #1=(|bfVar#30| |bfVar#31|) (CONS '|%BoundedSgement| (LIST . #1#))) -(DEFUN |%Tuple| #1=(|bfVar#30|) (CONS '|%Tuple| (LIST . #1#))) +(DEFUN |%Tuple| #1=(|bfVar#32|) (CONS '|%Tuple| (LIST . #1#))) -(DEFUN |%ColonAppend| #1=(|bfVar#31| |bfVar#32|) +(DEFUN |%ColonAppend| #1=(|bfVar#33| |bfVar#34|) (CONS '|%ColonAppend| (LIST . #1#))) -(DEFUN |%Pretend| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Pretend| (LIST . #1#))) +(DEFUN |%Pretend| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Pretend| (LIST . #1#))) -(DEFUN |%Is| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Is| (LIST . #1#))) +(DEFUN |%Is| #1=(|bfVar#37| |bfVar#38|) (CONS '|%Is| (LIST . #1#))) -(DEFUN |%Isnt| #1=(|bfVar#37| |bfVar#38|) (CONS '|%Isnt| (LIST . #1#))) +(DEFUN |%Isnt| #1=(|bfVar#39| |bfVar#40|) (CONS '|%Isnt| (LIST . #1#))) -(DEFUN |%Reduce| #1=(|bfVar#39| |bfVar#40|) (CONS '|%Reduce| (LIST . #1#))) +(DEFUN |%Reduce| #1=(|bfVar#41| |bfVar#42|) (CONS '|%Reduce| (LIST . #1#))) -(DEFUN |%PrefixExpr| #1=(|bfVar#41| |bfVar#42|) +(DEFUN |%PrefixExpr| #1=(|bfVar#43| |bfVar#44|) (CONS '|%PrefixExpr| (LIST . #1#))) -(DEFUN |%Call| #1=(|bfVar#43| |bfVar#44|) (CONS '|%Call| (LIST . #1#))) +(DEFUN |%Call| #1=(|bfVar#45| |bfVar#46|) (CONS '|%Call| (LIST . #1#))) -(DEFUN |%InfixExpr| #1=(|bfVar#45| |bfVar#46| |bfVar#47|) +(DEFUN |%InfixExpr| #1=(|bfVar#47| |bfVar#48| |bfVar#49|) (CONS '|%InfixExpr| (LIST . #1#))) -(DEFUN |%ConstantDefinition| #1=(|bfVar#48| |bfVar#49|) +(DEFUN |%ConstantDefinition| #1=(|bfVar#50| |bfVar#51|) (CONS '|%ConstantDefinition| (LIST . #1#))) -(DEFUN |%Definition| #1=(|bfVar#50| |bfVar#51| |bfVar#52|) +(DEFUN |%Definition| #1=(|bfVar#52| |bfVar#53| |bfVar#54|) (CONS '|%Definition| (LIST . #1#))) -(DEFUN |%Macro| #1=(|bfVar#53| |bfVar#54| |bfVar#55|) +(DEFUN |%Macro| #1=(|bfVar#55| |bfVar#56| |bfVar#57|) (CONS '|%Macro| (LIST . #1#))) -(DEFUN |%Lambda| #1=(|bfVar#56| |bfVar#57|) (CONS '|%Lambda| (LIST . #1#))) +(DEFUN |%Lambda| #1=(|bfVar#58| |bfVar#59|) (CONS '|%Lambda| (LIST . #1#))) -(DEFUN |%SuchThat| #1=(|bfVar#58|) (CONS '|%SuchThat| (LIST . #1#))) +(DEFUN |%SuchThat| #1=(|bfVar#60|) (CONS '|%SuchThat| (LIST . #1#))) -(DEFUN |%Assignment| #1=(|bfVar#59| |bfVar#60|) +(DEFUN |%Assignment| #1=(|bfVar#61| |bfVar#62|) (CONS '|%Assignment| (LIST . #1#))) -(DEFUN |%While| #1=(|bfVar#61|) (CONS '|%While| (LIST . #1#))) +(DEFUN |%While| #1=(|bfVar#63|) (CONS '|%While| (LIST . #1#))) -(DEFUN |%Until| #1=(|bfVar#62|) (CONS '|%Until| (LIST . #1#))) +(DEFUN |%Until| #1=(|bfVar#64|) (CONS '|%Until| (LIST . #1#))) -(DEFUN |%For| #1=(|bfVar#63| |bfVar#64| |bfVar#65|) (CONS '|%For| (LIST . #1#))) +(DEFUN |%For| #1=(|bfVar#65| |bfVar#66| |bfVar#67|) (CONS '|%For| (LIST . #1#))) -(DEFUN |%Implies| #1=(|bfVar#66| |bfVar#67|) (CONS '|%Implies| (LIST . #1#))) +(DEFUN |%Implies| #1=(|bfVar#68| |bfVar#69|) (CONS '|%Implies| (LIST . #1#))) -(DEFUN |%Iterators| #1=(|bfVar#68|) (CONS '|%Iterators| (LIST . #1#))) +(DEFUN |%Iterators| #1=(|bfVar#70|) (CONS '|%Iterators| (LIST . #1#))) -(DEFUN |%Cross| #1=(|bfVar#69|) (CONS '|%Cross| (LIST . #1#))) +(DEFUN |%Cross| #1=(|bfVar#71|) (CONS '|%Cross| (LIST . #1#))) -(DEFUN |%Repeat| #1=(|bfVar#70| |bfVar#71|) (CONS '|%Repeat| (LIST . #1#))) +(DEFUN |%Repeat| #1=(|bfVar#72| |bfVar#73|) (CONS '|%Repeat| (LIST . #1#))) -(DEFUN |%Pile| #1=(|bfVar#72|) (CONS '|%Pile| (LIST . #1#))) +(DEFUN |%Pile| #1=(|bfVar#74|) (CONS '|%Pile| (LIST . #1#))) -(DEFUN |%Append| #1=(|bfVar#73|) (CONS '|%Append| (LIST . #1#))) +(DEFUN |%Append| #1=(|bfVar#75|) (CONS '|%Append| (LIST . #1#))) -(DEFUN |%Case| #1=(|bfVar#74| |bfVar#75|) (CONS '|%Case| (LIST . #1#))) +(DEFUN |%Case| #1=(|bfVar#76| |bfVar#77|) (CONS '|%Case| (LIST . #1#))) -(DEFUN |%Return| #1=(|bfVar#76|) (CONS '|%Return| (LIST . #1#))) +(DEFUN |%Return| #1=(|bfVar#78|) (CONS '|%Return| (LIST . #1#))) -(DEFUN |%Leave| #1=(|bfVar#77|) (CONS '|%Leave| (LIST . #1#))) +(DEFUN |%Leave| #1=(|bfVar#79|) (CONS '|%Leave| (LIST . #1#))) -(DEFUN |%Throw| #1=(|bfVar#78|) (CONS '|%Throw| (LIST . #1#))) +(DEFUN |%Throw| #1=(|bfVar#80|) (CONS '|%Throw| (LIST . #1#))) -(DEFUN |%Catch| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Catch| (LIST . #1#))) +(DEFUN |%Catch| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Catch| (LIST . #1#))) -(DEFUN |%Finally| #1=(|bfVar#81|) (CONS '|%Finally| (LIST . #1#))) +(DEFUN |%Finally| #1=(|bfVar#83|) (CONS '|%Finally| (LIST . #1#))) -(DEFUN |%Try| #1=(|bfVar#82| |bfVar#83|) (CONS '|%Try| (LIST . #1#))) +(DEFUN |%Try| #1=(|bfVar#84| |bfVar#85|) (CONS '|%Try| (LIST . #1#))) -(DEFUN |%Where| #1=(|bfVar#84| |bfVar#85|) (CONS '|%Where| (LIST . #1#))) +(DEFUN |%Where| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Where| (LIST . #1#))) -(DEFUN |%Structure| #1=(|bfVar#86| |bfVar#87|) +(DEFUN |%Structure| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Structure| (LIST . #1#))) (DEFPARAMETER |$inDefIS| NIL) @@ -1151,8 +1153,38 @@ (COND ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|))) (T (|bpSpecificErrorHere| "expected identifier as property name")))) +(DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|)) + +(DEFUN |bfExpandKeys| (|l|) + (PROG (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|) + (RETURN + (PROGN + (SETQ |args| NIL) + (LOOP + (COND + ((NOT + (AND (CONSP |l|) + (PROGN (SETQ |a| (CAR |l|)) (SETQ |l| (CDR |l|)) T))) + (RETURN NIL)) + ((AND (CONSP |a|) (EQ (CAR |a|) '|%Key|) + (PROGN + (SETQ |ISTMP#1| (CDR |a|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |k| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) + (SETQ |args| + (CONS |x| + (CONS + (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD") + |args|)))) + (T (SETQ |args| (CONS |a| |args|))))) + (|reverse!| |args|))))) + (DEFUN |bfApplication| (|bfop| |bfarg|) - (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) + (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|)))) (T (LIST |bfop| |bfarg|)))) (DEFUN |bfReName| (|x|) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index f6799dbf..f8417b34 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -863,6 +863,7 @@ (COND ((|bpEqPeek| 'BEC) (|bpRestore| |a|) (OR (|bpAssignment|) (|bpTrap|))) ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (OR (|bpLambda|) (|bpTrap|))) + ((|bpEqPeek| 'LARROW) (|bpRestore| |a|) (OR (|bpKeyArg|) (|bpTrap|))) (T T))) (T (|bpRestore| |a|) NIL)))))) @@ -874,6 +875,10 @@ (AND (|bpVariable|) (|bpEqKey| 'GIVES) (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|bfLambda| (|bpPop2|) (|bpPop1|))))) +(DEFUN |bpKeyArg| () + (AND (|bpName|) (|bpEqKey| 'LARROW) (|bpLogical|) + (|bpPush| (|bfKeyArg| (|bpPop2|) (|bpPop1|))))) + (DEFUN |bpExit| () (AND (|bpAssign|) (OR diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index e59680a6..c259bda3 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -43,10 +43,10 @@ (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE) (LIST "=" 'SHOEEQ) (LIST "~=" 'SHOENE) (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST "->" 'ARROW) - (LIST ":=" 'BEC) (LIST "+->" 'GIVES) (LIST "==" 'DEF) - (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) - (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "'" 'QUOTE) - (LIST "|" 'BAR))) + (LIST "<-" 'LARROW) (LIST ":=" 'BEC) (LIST "+->" 'GIVES) + (LIST "==" 'DEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) + (LIST ")" 'CPAREN) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) + (LIST "'" 'QUOTE) (LIST "|" 'BAR))) (DEFUN |shoeKeyTableCons| () (PROG (|KeyTable|) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 2adea400..e8909318 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -110,6 +110,7 @@ shoeKeyWords == [ _ ['"#", "LENGTH"], _ ['"=>","EXIT" ], _ ['"->", "ARROW"],_ + ['"<-", "LARROW"], _ ['":=", "BEC"], _ ['"+->", "GIVES"], _ ['"==", "DEF"], _ -- cgit v1.2.3