aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot14
-rw-r--r--src/boot/parser.boot7
-rw-r--r--src/boot/strap/ast.clisp106
-rw-r--r--src/boot/strap/parser.clisp5
-rw-r--r--src/boot/strap/tokens.clisp8
-rw-r--r--src/boot/tokens.boot1
6 files changed, 99 insertions, 42 deletions
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"], _
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-17 10:23:46 +0000