aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog9
-rw-r--r--src/boot/ast.boot8
-rw-r--r--src/boot/parser.boot11
-rw-r--r--src/boot/strap/ast.clisp793
-rw-r--r--src/boot/strap/parser.clisp6
-rw-r--r--src/boot/strap/tokens.clisp10
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/cparse.boot18
9 files changed, 451 insertions, 407 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 59ae56a5..62e3808c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
2010-05-09 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ Add lambda expression syntax to Boot.
+ * boot/parser.boot (bpLambda): New.
+ * boot/ast.boot (bfLambda): New.
+ * boot/tokens.boot: Add "+->" as token.
+ * interp/cparse.boot: Use lambda expression syntax.
+ * interp/c-util.boot: Likewise.
+
+2010-05-09 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/tokens.boot: Don't rename 'car', 'cdr', and PAIRP.
2010-05-09 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 3ad7d4d8..878bb755 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -112,6 +112,7 @@ structure %Ast ==
%ConstantDefinition(%Name,%Ast) -- x == y
%Definition(%Name,%Ast,%Ast) -- f x == y
%Macro(%Name,%List,%Ast) -- m x ==> y
+ %Lambda(%List,%Ast) -- x +-> x**2
%SuchThat(%Ast) -- | p
%Assignment(%Ast,%Ast) -- x := y
%While(%Ast) -- while p -- iterator
@@ -742,6 +743,13 @@ bfLessp(l,r)==
l = 0 => ["PLUSP",r]
r = 0 => ["MINUSP", l]
["<",l,r]
+
+bfLambda(vars,body) ==
+ -- FIXME: Check that we have only names in vars.
+ vars :=
+ bfTupleP vars => rest vars
+ [vars]
+ ["LAMBDA",vars,body]
bfMDef (op,args,body) ==
argl :=
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index ce22eb37..e754375d 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -800,6 +800,9 @@ bpAssign()==
bpEqPeek "BEC" =>
bpRestore a
bpAssignment() or bpTrap()
+ bpEqPeek "GIVES" =>
+ bpRestore a
+ bpLambda() or bpTrap()
true
bpRestore a
false
@@ -810,6 +813,14 @@ bpAssignment()==
(bpAssign() or bpTrap()) and
bpPush bfAssign (bpPop2(),bpPop1())
+++ Parse a lambda expression
+++ Lambda ::= Variable +-> Assign
+bpLambda() ==
+ bpVariable() and
+ bpEqKey "GIVES" and
+ (bpAssign() or bpTrap()) and
+ bpPush bfLambda(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 485babb7..a754c468 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -105,47 +105,50 @@
(DEFUN |%Macro| #0=(|bfVar#49| |bfVar#50| |bfVar#51|)
(CONS '|%Macro| (LIST . #0#)))
-(DEFUN |%SuchThat| #0=(|bfVar#52|) (CONS '|%SuchThat| (LIST . #0#)))
+(DEFUN |%Lambda| #0=(|bfVar#52| |bfVar#53|)
+ (CONS '|%Lambda| (LIST . #0#)))
-(DEFUN |%Assignment| #0=(|bfVar#53| |bfVar#54|)
+(DEFUN |%SuchThat| #0=(|bfVar#54|) (CONS '|%SuchThat| (LIST . #0#)))
+
+(DEFUN |%Assignment| #0=(|bfVar#55| |bfVar#56|)
(CONS '|%Assignment| (LIST . #0#)))
-(DEFUN |%While| #0=(|bfVar#55|) (CONS '|%While| (LIST . #0#)))
+(DEFUN |%While| #0=(|bfVar#57|) (CONS '|%While| (LIST . #0#)))
-(DEFUN |%Until| #0=(|bfVar#56|) (CONS '|%Until| (LIST . #0#)))
+(DEFUN |%Until| #0=(|bfVar#58|) (CONS '|%Until| (LIST . #0#)))
-(DEFUN |%For| #0=(|bfVar#57| |bfVar#58| |bfVar#59|)
+(DEFUN |%For| #0=(|bfVar#59| |bfVar#60| |bfVar#61|)
(CONS '|%For| (LIST . #0#)))
-(DEFUN |%Implies| #0=(|bfVar#60| |bfVar#61|)
+(DEFUN |%Implies| #0=(|bfVar#62| |bfVar#63|)
(CONS '|%Implies| (LIST . #0#)))
-(DEFUN |%Iterators| #0=(|bfVar#62|) (CONS '|%Iterators| (LIST . #0#)))
+(DEFUN |%Iterators| #0=(|bfVar#64|) (CONS '|%Iterators| (LIST . #0#)))
-(DEFUN |%Cross| #0=(|bfVar#63|) (CONS '|%Cross| (LIST . #0#)))
+(DEFUN |%Cross| #0=(|bfVar#65|) (CONS '|%Cross| (LIST . #0#)))
-(DEFUN |%Repeat| #0=(|bfVar#64| |bfVar#65|)
+(DEFUN |%Repeat| #0=(|bfVar#66| |bfVar#67|)
(CONS '|%Repeat| (LIST . #0#)))
-(DEFUN |%Pile| #0=(|bfVar#66|) (CONS '|%Pile| (LIST . #0#)))
+(DEFUN |%Pile| #0=(|bfVar#68|) (CONS '|%Pile| (LIST . #0#)))
-(DEFUN |%Append| #0=(|bfVar#67|) (CONS '|%Append| (LIST . #0#)))
+(DEFUN |%Append| #0=(|bfVar#69|) (CONS '|%Append| (LIST . #0#)))
-(DEFUN |%Case| #0=(|bfVar#68| |bfVar#69|)
+(DEFUN |%Case| #0=(|bfVar#70| |bfVar#71|)
(CONS '|%Case| (LIST . #0#)))
-(DEFUN |%Return| #0=(|bfVar#70|) (CONS '|%Return| (LIST . #0#)))
+(DEFUN |%Return| #0=(|bfVar#72|) (CONS '|%Return| (LIST . #0#)))
-(DEFUN |%Throw| #0=(|bfVar#71|) (CONS '|%Throw| (LIST . #0#)))
+(DEFUN |%Throw| #0=(|bfVar#73|) (CONS '|%Throw| (LIST . #0#)))
-(DEFUN |%Catch| #0=(|bfVar#72|) (CONS '|%Catch| (LIST . #0#)))
+(DEFUN |%Catch| #0=(|bfVar#74|) (CONS '|%Catch| (LIST . #0#)))
-(DEFUN |%Try| #0=(|bfVar#73| |bfVar#74|) (CONS '|%Try| (LIST . #0#)))
+(DEFUN |%Try| #0=(|bfVar#75| |bfVar#76|) (CONS '|%Try| (LIST . #0#)))
-(DEFUN |%Where| #0=(|bfVar#75| |bfVar#76|)
+(DEFUN |%Where| #0=(|bfVar#77| |bfVar#78|)
(CONS '|%Where| (LIST . #0#)))
-(DEFUN |%Structure| #0=(|bfVar#77| |bfVar#78|)
+(DEFUN |%Structure| #0=(|bfVar#79| |bfVar#80|)
(CONS '|%Structure| (LIST . #0#)))
(DEFPARAMETER |$inDefIS| NIL)
@@ -244,21 +247,21 @@
(PROGN
(SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) (T (LIST |b|))))
(COND
- ((LET ((|bfVar#80| NIL) (|bfVar#79| |a|) (|x| NIL))
+ ((LET ((|bfVar#82| NIL) (|bfVar#81| |a|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#79|)
- (PROGN (SETQ |x| (CAR |bfVar#79|)) NIL))
- (RETURN |bfVar#80|))
+ ((OR (ATOM |bfVar#81|)
+ (PROGN (SETQ |x| (CAR |bfVar#81|)) NIL))
+ (RETURN |bfVar#82|))
(T (PROGN
- (SETQ |bfVar#80|
+ (SETQ |bfVar#82|
(AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(NULL (CDR |ISTMP#1|))))))
- (COND (|bfVar#80| (RETURN |bfVar#80|))))))
- (SETQ |bfVar#79| (CDR |bfVar#79|))))
+ (COND (|bfVar#82| (RETURN |bfVar#82|))))))
+ (SETQ |bfVar#81| (CDR |bfVar#81|))))
(|bfMakeCons| |a|))
(T (CONS 'LIST |a|)))))))
@@ -410,19 +413,19 @@
(COND
((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
(T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
- (LET ((|bfVar#83| NIL) (|bfVar#81| |f|) (|i| NIL)
- (|bfVar#82| |r|) (|j| NIL))
+ (LET ((|bfVar#85| NIL) (|bfVar#83| |f|) (|i| NIL)
+ (|bfVar#84| |r|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#81|)
- (PROGN (SETQ |i| (CAR |bfVar#81|)) NIL)
- (ATOM |bfVar#82|)
- (PROGN (SETQ |j| (CAR |bfVar#82|)) NIL))
- (RETURN (NREVERSE |bfVar#83|)))
- (T (SETQ |bfVar#83|
- (CONS (APPEND |i| |j|) |bfVar#83|))))
- (SETQ |bfVar#81| (CDR |bfVar#81|))
- (SETQ |bfVar#82| (CDR |bfVar#82|)))))))))
+ ((OR (ATOM |bfVar#83|)
+ (PROGN (SETQ |i| (CAR |bfVar#83|)) NIL)
+ (ATOM |bfVar#84|)
+ (PROGN (SETQ |j| (CAR |bfVar#84|)) NIL))
+ (RETURN (NREVERSE |bfVar#85|)))
+ (T (SETQ |bfVar#85|
+ (CONS (APPEND |i| |j|) |bfVar#85|))))
+ (SETQ |bfVar#83| (CDR |bfVar#83|))
+ (SETQ |bfVar#84| (CDR |bfVar#84|)))))))))
(DEFUN |bfReduce| (|op| |y|)
(PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
@@ -540,25 +543,25 @@
(COND
(|vars| (SETQ |loop|
(LIST 'LET
- (LET ((|bfVar#86| NIL)
- (|bfVar#84| |vars|) (|v| NIL)
- (|bfVar#85| |inits|) (|i| NIL))
+ (LET ((|bfVar#88| NIL)
+ (|bfVar#86| |vars|) (|v| NIL)
+ (|bfVar#87| |inits|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#84|)
+ ((OR (ATOM |bfVar#86|)
(PROGN
- (SETQ |v| (CAR |bfVar#84|))
+ (SETQ |v| (CAR |bfVar#86|))
NIL)
- (ATOM |bfVar#85|)
+ (ATOM |bfVar#87|)
(PROGN
- (SETQ |i| (CAR |bfVar#85|))
+ (SETQ |i| (CAR |bfVar#87|))
NIL))
- (RETURN (NREVERSE |bfVar#86|)))
+ (RETURN (NREVERSE |bfVar#88|)))
(T
- (SETQ |bfVar#86|
- (CONS (LIST |v| |i|) |bfVar#86|))))
- (SETQ |bfVar#84| (CDR |bfVar#84|))
- (SETQ |bfVar#85| (CDR |bfVar#85|))))
+ (SETQ |bfVar#88|
+ (CONS (LIST |v| |i|) |bfVar#88|))))
+ (SETQ |bfVar#86| (CDR |bfVar#86|))
+ (SETQ |bfVar#87| (CDR |bfVar#87|))))
|loop|))))
|loop|))))
@@ -1079,16 +1082,16 @@
(SETQ |ISTMP#1| (CDR |seq|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |seq'| (CAR |ISTMP#1|)) T)))
- (LET ((|bfVar#88| T) (|bfVar#87| |seq'|) (|x| NIL))
+ (LET ((|bfVar#90| T) (|bfVar#89| |seq'|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#87|)
- (PROGN (SETQ |x| (CAR |bfVar#87|)) NIL))
- (RETURN |bfVar#88|))
+ ((OR (ATOM |bfVar#89|)
+ (PROGN (SETQ |x| (CAR |bfVar#89|)) NIL))
+ (RETURN |bfVar#90|))
(T (PROGN
- (SETQ |bfVar#88| (SYMBOLP |x|))
- (COND ((NOT |bfVar#88|) (RETURN NIL))))))
- (SETQ |bfVar#87| (CDR |bfVar#87|)))))
+ (SETQ |bfVar#90| (SYMBOLP |x|))
+ (COND ((NOT |bfVar#90|) (RETURN NIL))))))
+ (SETQ |bfVar#89| (CDR |bfVar#89|)))))
(LIST 'MEMQ |var| |seq|))
((AND (CONSP |var|) (EQ (CAR |var|) 'QUOTE)
(PROGN
@@ -1145,32 +1148,32 @@
((NULL |l|) NIL)
((NULL (CDR |l|)) (CAR |l|))
(T (CONS 'OR
- (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL))
+ (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#89|)
- (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL))
- (RETURN (NREVERSE |bfVar#90|)))
- (T (SETQ |bfVar#90|
+ ((OR (ATOM |bfVar#91|)
+ (PROGN (SETQ |c| (CAR |bfVar#91|)) NIL))
+ (RETURN (NREVERSE |bfVar#92|)))
+ (T (SETQ |bfVar#92|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#90|))))
- (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
+ |bfVar#92|))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|))))))))
(DEFUN |bfAND| (|l|)
(COND
((NULL |l|) T)
((NULL (CDR |l|)) (CAR |l|))
(T (CONS 'AND
- (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL))
+ (LET ((|bfVar#94| NIL) (|bfVar#93| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#91|)
- (PROGN (SETQ |c| (CAR |bfVar#91|)) NIL))
- (RETURN (NREVERSE |bfVar#92|)))
- (T (SETQ |bfVar#92|
+ ((OR (ATOM |bfVar#93|)
+ (PROGN (SETQ |c| (CAR |bfVar#93|)) NIL))
+ (RETURN (NREVERSE |bfVar#94|)))
+ (T (SETQ |bfVar#94|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#92|))))
- (SETQ |bfVar#91| (CDR |bfVar#91|))))))))
+ |bfVar#94|))))
+ (SETQ |bfVar#93| (CDR |bfVar#93|))))))))
(DEFUN |defQuoteId| (|x|)
(AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|))))
@@ -1194,6 +1197,12 @@
((EQL |r| 0) (LIST 'MINUSP |l|))
(T (LIST '< |l| |r|))))
+(DEFUN |bfLambda| (|vars| |body|)
+ (PROGN
+ (SETQ |vars|
+ (COND ((|bfTupleP| |vars|) (CDR |vars|)) (T (LIST |vars|))))
+ (LIST 'LAMBDA |vars| |body|)))
+
(DEFUN |bfMDef| (|op| |args| |body|)
(PROG (|def| |lamex| |sb2| |sb| |largl| |nargl| |sgargl| |gargl|
|LETTMP#1| |argl|)
@@ -1210,52 +1219,52 @@
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- (LET ((|bfVar#95| NIL) (|bfVar#93| |nargl|) (|i| NIL)
- (|bfVar#94| |sgargl|) (|j| NIL))
+ (LET ((|bfVar#97| NIL) (|bfVar#95| |nargl|) (|i| NIL)
+ (|bfVar#96| |sgargl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#93|)
- (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL)
- (ATOM |bfVar#94|)
- (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL))
- (RETURN (NREVERSE |bfVar#95|)))
- (T (SETQ |bfVar#95|
- (CONS (CONS |i| |j|) |bfVar#95|))))
- (SETQ |bfVar#93| (CDR |bfVar#93|))
- (SETQ |bfVar#94| (CDR |bfVar#94|)))))
+ ((OR (ATOM |bfVar#95|)
+ (PROGN (SETQ |i| (CAR |bfVar#95|)) NIL)
+ (ATOM |bfVar#96|)
+ (PROGN (SETQ |j| (CAR |bfVar#96|)) NIL))
+ (RETURN (NREVERSE |bfVar#97|)))
+ (T (SETQ |bfVar#97|
+ (CONS (CONS |i| |j|) |bfVar#97|))))
+ (SETQ |bfVar#95| (CDR |bfVar#95|))
+ (SETQ |bfVar#96| (CDR |bfVar#96|)))))
(SETQ |body| (SUBLIS |sb| |body|))
(SETQ |sb2|
- (LET ((|bfVar#98| NIL) (|bfVar#96| |sgargl|) (|i| NIL)
- (|bfVar#97| |largl|) (|j| NIL))
+ (LET ((|bfVar#100| NIL) (|bfVar#98| |sgargl|) (|i| NIL)
+ (|bfVar#99| |largl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#96|)
- (PROGN (SETQ |i| (CAR |bfVar#96|)) NIL)
- (ATOM |bfVar#97|)
- (PROGN (SETQ |j| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
- (T (SETQ |bfVar#98|
+ ((OR (ATOM |bfVar#98|)
+ (PROGN (SETQ |i| (CAR |bfVar#98|)) NIL)
+ (ATOM |bfVar#99|)
+ (PROGN (SETQ |j| (CAR |bfVar#99|)) NIL))
+ (RETURN (NREVERSE |bfVar#100|)))
+ (T (SETQ |bfVar#100|
(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
- |bfVar#98|))))
- (SETQ |bfVar#96| (CDR |bfVar#96|))
- (SETQ |bfVar#97| (CDR |bfVar#97|)))))
+ |bfVar#100|))))
+ (SETQ |bfVar#98| (CDR |bfVar#98|))
+ (SETQ |bfVar#99| (CDR |bfVar#99|)))))
(SETQ |body|
(LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
(SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
(SETQ |def| (LIST |op| |lamex|))
(CONS (|shoeComp| |def|)
- (LET ((|bfVar#100| NIL) (|bfVar#99| |$wheredefs|)
+ (LET ((|bfVar#102| NIL) (|bfVar#101| |$wheredefs|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#99|)
- (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL))
- (RETURN (NREVERSE |bfVar#100|)))
- (T (SETQ |bfVar#100|
+ ((OR (ATOM |bfVar#101|)
+ (PROGN (SETQ |d| (CAR |bfVar#101|)) NIL))
+ (RETURN (NREVERSE |bfVar#102|)))
+ (T (SETQ |bfVar#102|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#100|))))
- (SETQ |bfVar#99| (CDR |bfVar#99|)))))))))
+ |bfVar#102|))))
+ (SETQ |bfVar#101| (CDR |bfVar#101|)))))))))
(DEFUN |bfGargl| (|argl|)
(PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -1275,13 +1284,13 @@
(LIST (CONS |f| |a|) (CONS |f| |b|)
(CONS (CAR |argl|) |c|) (CONS |f| |d|)))))))))
-(DEFUN |bfDef1| (|bfVar#101|)
+(DEFUN |bfDef1| (|bfVar#103|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op|)
(RETURN
(PROGN
- (SETQ |op| (CAR |bfVar#101|))
- (SETQ |args| (CADR . #0=(|bfVar#101|)))
+ (SETQ |op| (CAR |bfVar#103|))
+ (SETQ |args| (CADR . #0=(|bfVar#103|)))
(SETQ |body| (CADDR . #0#))
(SETQ |argl|
(COND
@@ -1322,30 +1331,30 @@
(SETQ |arg1| (CADDR . #0#)) (SETQ |body1| (CDDDR . #0#))
(|bfCompHash| |op1| |arg1| |body1|))
(T (|bfTuple|
- (LET ((|bfVar#103| NIL)
- (|bfVar#102|
+ (LET ((|bfVar#105| NIL)
+ (|bfVar#104|
(CONS (LIST |op| |args| |body|) |$wheredefs|))
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#102|)
- (PROGN (SETQ |d| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
- (T (SETQ |bfVar#103|
+ ((OR (ATOM |bfVar#104|)
+ (PROGN (SETQ |d| (CAR |bfVar#104|)) NIL))
+ (RETURN (NREVERSE |bfVar#105|)))
+ (T (SETQ |bfVar#105|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#103|))))
- (SETQ |bfVar#102| (CDR |bfVar#102|))))))))))
+ |bfVar#105|))))
+ (SETQ |bfVar#104| (CDR |bfVar#104|))))))))))
(DEFUN |shoeComps| (|x|)
- (LET ((|bfVar#105| NIL) (|bfVar#104| |x|) (|def| NIL))
+ (LET ((|bfVar#107| NIL) (|bfVar#106| |x|) (|def| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#104|)
- (PROGN (SETQ |def| (CAR |bfVar#104|)) NIL))
- (RETURN (NREVERSE |bfVar#105|)))
- (T (SETQ |bfVar#105| (CONS (|shoeComp| |def|) |bfVar#105|))))
- (SETQ |bfVar#104| (CDR |bfVar#104|)))))
+ ((OR (ATOM |bfVar#106|)
+ (PROGN (SETQ |def| (CAR |bfVar#106|)) NIL))
+ (RETURN (NREVERSE |bfVar#107|)))
+ (T (SETQ |bfVar#107| (CONS (|shoeComp| |def|) |bfVar#107|))))
+ (SETQ |bfVar#106| (CDR |bfVar#106|)))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -1487,16 +1496,16 @@
(COND
((MEMQ |op| '(RETURN RETURN-FROM)) T)
((MEMQ |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
- ((LET ((|bfVar#107| NIL) (|bfVar#106| |body|) (|t| NIL))
+ ((LET ((|bfVar#109| NIL) (|bfVar#108| |body|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#106|)
- (PROGN (SETQ |t| (CAR |bfVar#106|)) NIL))
- (RETURN |bfVar#107|))
+ ((OR (ATOM |bfVar#108|)
+ (PROGN (SETQ |t| (CAR |bfVar#108|)) NIL))
+ (RETURN |bfVar#109|))
(T (PROGN
- (SETQ |bfVar#107| (|needsPROG| |t|))
- (COND (|bfVar#107| (RETURN |bfVar#107|))))))
- (SETQ |bfVar#106| (CDR |bfVar#106|))))
+ (SETQ |bfVar#109| (|needsPROG| |t|))
+ (COND (|bfVar#109| (RETURN |bfVar#109|))))))
+ (SETQ |bfVar#108| (CDR |bfVar#108|))))
T)
(T NIL)))))))
@@ -1588,11 +1597,11 @@
(T (CONS (CADR |l|) |$fluidVars|))))
(RPLACA (CDR |x|) (CADR |l|)))))
((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
- (LET ((|bfVar#108| (CADR |x|)) (|y| NIL))
+ (LET ((|bfVar#110| (CADR |x|)) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#108|)
- (PROGN (SETQ |y| (CAR |bfVar#108|)) NIL))
+ ((OR (ATOM |bfVar#110|)
+ (PROGN (SETQ |y| (CAR |bfVar#110|)) NIL))
(RETURN NIL))
(T (COND
((NOT (MEMQ |y| |$locVars|))
@@ -1601,22 +1610,22 @@
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#108| (CDR |bfVar#108|))))
+ (SETQ |bfVar#110| (CDR |bfVar#110|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- (LET ((|bfVar#110| NIL) (|bfVar#109| |$locVars|)
+ (LET ((|bfVar#112| NIL) (|bfVar#111| |$locVars|)
(|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#109|)
+ ((OR (ATOM |bfVar#111|)
(PROGN
- (SETQ |y| (CAR |bfVar#109|))
+ (SETQ |y| (CAR |bfVar#111|))
NIL))
- (RETURN (NREVERSE |bfVar#110|)))
+ (RETURN (NREVERSE |bfVar#112|)))
(T (AND (NOT (MEMQ |y| |newbindings|))
- (SETQ |bfVar#110|
- (CONS |y| |bfVar#110|)))))
- (SETQ |bfVar#109| (CDR |bfVar#109|))))))
+ (SETQ |bfVar#112|
+ (CONS |y| |bfVar#112|)))))
+ (SETQ |bfVar#111| (CDR |bfVar#111|))))))
(T (|shoeCompTran1| (CAR |x|))
(|shoeCompTran1| (CDR |x|)))))))))
@@ -1703,13 +1712,13 @@
(RETURN
(PROGN
(SETQ |a|
- (LET ((|bfVar#111| NIL) (|c| |l|))
+ (LET ((|bfVar#113| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#111|)))
- (T (SETQ |bfVar#111|
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#113|)))
+ (T (SETQ |bfVar#113|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#111|))))
+ |bfVar#113|))))
(SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
@@ -1727,17 +1736,17 @@
((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN))
(COND
((CDR |x|)
- (LET ((|bfVar#113| NIL) (|bfVar#112| (CDR |f|))
+ (LET ((|bfVar#115| NIL) (|bfVar#114| (CDR |f|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#112|)
- (PROGN (SETQ |i| (CAR |bfVar#112|)) NIL))
- (RETURN (NREVERSE |bfVar#113|)))
+ ((OR (ATOM |bfVar#114|)
+ (PROGN (SETQ |i| (CAR |bfVar#114|)) NIL))
+ (RETURN (NREVERSE |bfVar#115|)))
(T (AND (NOT (ATOM |i|))
- (SETQ |bfVar#113|
- (CONS |i| |bfVar#113|)))))
- (SETQ |bfVar#112| (CDR |bfVar#112|)))))
+ (SETQ |bfVar#115|
+ (CONS |i| |bfVar#115|)))))
+ (SETQ |bfVar#114| (CDR |bfVar#114|)))))
(T (CDR |f|))))
(T (LIST |f|))))))))
@@ -1786,11 +1795,11 @@
(COND
((NULL |l|) NIL)
(T (SETQ |transform|
- (LET ((|bfVar#115| NIL) (|bfVar#114| |l|) (|x| NIL))
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |l|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#114|)
- (PROGN (SETQ |x| (CAR |bfVar#114|)) NIL)
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |x| (CAR |bfVar#116|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -1824,11 +1833,11 @@
(SETQ |b|
(CAR |ISTMP#5|))
T))))))))))))))
- (RETURN (NREVERSE |bfVar#115|)))
- (T (SETQ |bfVar#115|
+ (RETURN (NREVERSE |bfVar#117|)))
+ (T (SETQ |bfVar#117|
(CONS (|bfAlternative| |a| |b|)
- |bfVar#115|))))
- (SETQ |bfVar#114| (CDR |bfVar#114|)))))
+ |bfVar#117|))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -1860,17 +1869,17 @@
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- (LET ((|bfVar#117| NIL) (|bfVar#116| |defs|) (|d| NIL))
+ (LET ((|bfVar#119| NIL) (|bfVar#118| |defs|) (|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#116|)
- (PROGN (SETQ |d| (CAR |bfVar#116|)) NIL))
- (RETURN (NREVERSE |bfVar#117|)))
- (T (SETQ |bfVar#117|
+ ((OR (ATOM |bfVar#118|)
+ (PROGN (SETQ |d| (CAR |bfVar#118|)) NIL))
+ (RETURN (NREVERSE |bfVar#119|)))
+ (T (SETQ |bfVar#119|
(CONS (LIST (CAR |d|) (CADR |d|)
(|bfSUBLIS| |opassoc| (CADDR |d|)))
- |bfVar#117|))))
- (SETQ |bfVar#116| (CDR |bfVar#116|)))))
+ |bfVar#119|))))
+ (SETQ |bfVar#118| (CDR |bfVar#118|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -1954,16 +1963,16 @@
((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|))
(LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|))))
(T (SETQ |a|
- (LET ((|bfVar#119| NIL) (|bfVar#118| (CDR |x|))
+ (LET ((|bfVar#121| NIL) (|bfVar#120| (CDR |x|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#118|)
- (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL))
- (RETURN (NREVERSE |bfVar#119|)))
- (T (SETQ |bfVar#119|
- (CONS (|bfGenSymbol|) |bfVar#119|))))
- (SETQ |bfVar#118| (CDR |bfVar#118|)))))
+ ((OR (ATOM |bfVar#120|)
+ (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL))
+ (RETURN (NREVERSE |bfVar#121|)))
+ (T (SETQ |bfVar#121|
+ (CONS (|bfGenSymbol|) |bfVar#121|))))
+ (SETQ |bfVar#120| (CDR |bfVar#120|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -1990,21 +1999,21 @@
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- (LET ((|bfVar#122| NIL) (|bfVar#121| |x|) (|bfVar#120| NIL))
+ (LET ((|bfVar#124| NIL) (|bfVar#123| |x|) (|bfVar#122| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#121|)
- (PROGN (SETQ |bfVar#120| (CAR |bfVar#121|)) NIL))
- (RETURN (NREVERSE |bfVar#122|)))
- (T (AND (CONSP |bfVar#120|)
+ ((OR (ATOM |bfVar#123|)
+ (PROGN (SETQ |bfVar#122| (CAR |bfVar#123|)) NIL))
+ (RETURN (NREVERSE |bfVar#124|)))
+ (T (AND (CONSP |bfVar#122|)
(PROGN
- (SETQ |i| (CAR |bfVar#120|))
- (SETQ |ISTMP#1| (CDR |bfVar#120|))
+ (SETQ |i| (CAR |bfVar#122|))
+ (SETQ |ISTMP#1| (CDR |bfVar#122|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |j| (CAR |ISTMP#1|)) T)))
- (SETQ |bfVar#122|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#122|)))))
- (SETQ |bfVar#121| (CDR |bfVar#121|)))))))
+ (SETQ |bfVar#124|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#124|)))))
+ (SETQ |bfVar#123| (CDR |bfVar#123|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|))
@@ -2016,19 +2025,19 @@
(COND
((NULL |a|) (LIST (CAR |x|) |y|))
(T (SETQ |b|
- (LET ((|bfVar#124| NIL) (|bfVar#123| |a|) (|i| NIL)
+ (LET ((|bfVar#126| NIL) (|bfVar#125| |a|) (|i| NIL)
(|j| 1))
(LOOP
(COND
- ((OR (ATOM |bfVar#123|)
- (PROGN (SETQ |i| (CAR |bfVar#123|)) NIL))
- (RETURN (NREVERSE |bfVar#124|)))
+ ((OR (ATOM |bfVar#125|)
+ (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL))
+ (RETURN (NREVERSE |bfVar#126|)))
(T (AND (NOT (EQ |i| 'DOT))
- (SETQ |bfVar#124|
+ (SETQ |bfVar#126|
(CONS
(LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#124|)))))
- (SETQ |bfVar#123| (CDR |bfVar#123|))
+ |bfVar#126|)))))
+ (SETQ |bfVar#125| (CDR |bfVar#125|))
(SETQ |j| (+ |j| 1)))))
(COND
((NULL |b|) (LIST (CAR |x|) |y|))
@@ -2049,10 +2058,10 @@
(DEFUN |bfTry| (|e| |cs|)
(COND
((NULL |cs|) |e|)
- (T (LET ((|bfVar#125| (CAR |cs|)))
- (CASE (CAR |bfVar#125|)
+ (T (LET ((|bfVar#127| (CAR |cs|)))
+ (CASE (CAR |bfVar#127|)
(|%Catch|
- (LET ((|tag| (CADR |bfVar#125|)))
+ (LET ((|tag| (CADR |bfVar#127|)))
(COND
((ATOM |tag|)
(|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|)
@@ -2072,16 +2081,16 @@
((ATOM |form|)
(COND ((MEMBER |form| |params|) |form|) (T (|quote| |form|))))
(T (CONS 'LIST
- (LET ((|bfVar#127| NIL) (|bfVar#126| |form|) (|t| NIL))
+ (LET ((|bfVar#129| NIL) (|bfVar#128| |form|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#126|)
- (PROGN (SETQ |t| (CAR |bfVar#126|)) NIL))
- (RETURN (NREVERSE |bfVar#127|)))
- (T (SETQ |bfVar#127|
+ ((OR (ATOM |bfVar#128|)
+ (PROGN (SETQ |t| (CAR |bfVar#128|)) NIL))
+ (RETURN (NREVERSE |bfVar#129|)))
+ (T (SETQ |bfVar#129|
(CONS (|backquote| |t| |params|)
- |bfVar#127|))))
- (SETQ |bfVar#126| (CDR |bfVar#126|))))))))
+ |bfVar#129|))))
+ (SETQ |bfVar#128| (CDR |bfVar#128|))))))))
(DEFUN |genTypeAlias| (|head| |body|)
(PROG (|args| |op|)
@@ -2281,47 +2290,47 @@
(RETURN
(PROGN
(SETQ |argtypes|
- (LET ((|bfVar#129| NIL) (|bfVar#128| |s|) (|x| NIL))
+ (LET ((|bfVar#131| NIL) (|bfVar#130| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#128|)
- (PROGN (SETQ |x| (CAR |bfVar#128|)) NIL))
- (RETURN (NREVERSE |bfVar#129|)))
- (T (SETQ |bfVar#129|
+ ((OR (ATOM |bfVar#130|)
+ (PROGN (SETQ |x| (CAR |bfVar#130|)) NIL))
+ (RETURN (NREVERSE |bfVar#131|)))
+ (T (SETQ |bfVar#131|
(CONS (|nativeArgumentType| |x|)
- |bfVar#129|))))
- (SETQ |bfVar#128| (CDR |bfVar#128|)))))
+ |bfVar#131|))))
+ (SETQ |bfVar#130| (CDR |bfVar#130|)))))
(SETQ |rettype| (|nativeReturnType| |t|))
(COND
- ((LET ((|bfVar#131| T) (|bfVar#130| (CONS |t| |s|))
+ ((LET ((|bfVar#133| T) (|bfVar#132| (CONS |t| |s|))
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#130|)
- (PROGN (SETQ |x| (CAR |bfVar#130|)) NIL))
- (RETURN |bfVar#131|))
+ ((OR (ATOM |bfVar#132|)
+ (PROGN (SETQ |x| (CAR |bfVar#132|)) NIL))
+ (RETURN |bfVar#133|))
(T (PROGN
- (SETQ |bfVar#131| (|isSimpleNativeType| |x|))
- (COND ((NOT |bfVar#131|) (RETURN NIL))))))
- (SETQ |bfVar#130| (CDR |bfVar#130|))))
+ (SETQ |bfVar#133| (|isSimpleNativeType| |x|))
+ (COND ((NOT |bfVar#133|) (RETURN NIL))))))
+ (SETQ |bfVar#132| (CDR |bfVar#132|))))
(LIST (LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| (SYMBOL-NAME |op'|)))))
(T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
(SETQ |cargs|
- (LET ((|bfVar#138| NIL)
- (|bfVar#137| (- (LENGTH |s|) 1)) (|i| 0))
+ (LET ((|bfVar#140| NIL)
+ (|bfVar#139| (- (LENGTH |s|) 1)) (|i| 0))
(LOOP
(COND
- ((> |i| |bfVar#137|)
- (RETURN (NREVERSE |bfVar#138|)))
- (T (SETQ |bfVar#138|
+ ((> |i| |bfVar#139|)
+ (RETURN (NREVERSE |bfVar#140|)))
+ (T (SETQ |bfVar#140|
(CONS (|genGCLnativeTranslation,mkCArgName|
|i|)
- |bfVar#138|))))
+ |bfVar#140|))))
(SETQ |i| (+ |i| 1)))))
(SETQ |ccode|
- (LET ((|bfVar#134| "")
- (|bfVar#136|
+ (LET ((|bfVar#136| "")
+ (|bfVar#138|
(CONS (|genGCLnativeTranslation,gclTypeInC|
|t|)
(CONS " "
@@ -2329,20 +2338,20 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#132| NIL) (|x| |s|)
+ ((|bfVar#134| NIL) (|x| |s|)
(|a| |cargs|))
(LOOP
(COND
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
- (NREVERSE |bfVar#132|)))
+ (NREVERSE |bfVar#134|)))
(T
- (SETQ |bfVar#132|
+ (SETQ |bfVar#134|
(CONS
(|genGCLnativeTranslation,cparm|
|x| |a|)
- |bfVar#132|))))
+ |bfVar#134|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS ") { "
@@ -2355,7 +2364,7 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#133| NIL)
+ ((|bfVar#135| NIL)
(|x| |s|) (|a| |cargs|))
(LOOP
(COND
@@ -2363,27 +2372,27 @@
(ATOM |a|))
(RETURN
(NREVERSE
- |bfVar#133|)))
+ |bfVar#135|)))
(T
- (SETQ |bfVar#133|
+ (SETQ |bfVar#135|
(CONS
(|genGCLnativeTranslation,gclArgsInC|
|x| |a|)
- |bfVar#133|))))
+ |bfVar#135|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS "); }" NIL))))))))))))
- (|bfVar#135| NIL))
+ (|bfVar#137| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#136|)
+ ((OR (ATOM |bfVar#138|)
(PROGN
- (SETQ |bfVar#135| (CAR |bfVar#136|))
+ (SETQ |bfVar#137| (CAR |bfVar#138|))
NIL))
- (RETURN |bfVar#134|))
- (T (SETQ |bfVar#134|
- (CONCAT |bfVar#134| |bfVar#135|))))
- (SETQ |bfVar#136| (CDR |bfVar#136|)))))
+ (RETURN |bfVar#136|))
+ (T (SETQ |bfVar#136|
+ (CONCAT |bfVar#136| |bfVar#137|))))
+ (SETQ |bfVar#138| (CDR |bfVar#138|)))))
(LIST (LIST 'CLINES |ccode|)
(LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| |cop|)))))))))
@@ -2443,17 +2452,17 @@
(PROGN
(SETQ |args| NIL)
(SETQ |argtypes| NIL)
- (LET ((|bfVar#139| |s|) (|x| NIL))
+ (LET ((|bfVar#141| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#139|)
- (PROGN (SETQ |x| (CAR |bfVar#139|)) NIL))
+ ((OR (ATOM |bfVar#141|)
+ (PROGN (SETQ |x| (CAR |bfVar#141|)) NIL))
(RETURN NIL))
(T (PROGN
(SETQ |argtypes|
(CONS (|nativeArgumentType| |x|) |argtypes|))
(SETQ |args| (CONS (GENSYM) |args|)))))
- (SETQ |bfVar#139| (CDR |bfVar#139|))))
+ (SETQ |bfVar#141| (CDR |bfVar#141|))))
(SETQ |args| (REVERSE |args|))
(SETQ |rettype| (|nativeReturnType| |t|))
(LIST (LIST 'DEFUN |op| |args|
@@ -2464,39 +2473,39 @@
:ONE-LINER T)))))))
(DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|)
- (LET ((|bfVar#143| "")
- (|bfVar#145|
+ (LET ((|bfVar#145| "")
+ (|bfVar#147|
(CONS (SYMBOL-NAME |op|)
(CONS "("
- (APPEND (LET ((|bfVar#142| NIL)
- (|bfVar#140| (- |n| 1)) (|i| 0)
- (|bfVar#141| |s|) (|x| NIL))
+ (APPEND (LET ((|bfVar#144| NIL)
+ (|bfVar#142| (- |n| 1)) (|i| 0)
+ (|bfVar#143| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (> |i| |bfVar#140|)
- (ATOM |bfVar#141|)
+ ((OR (> |i| |bfVar#142|)
+ (ATOM |bfVar#143|)
(PROGN
- (SETQ |x| (CAR |bfVar#141|))
+ (SETQ |x| (CAR |bfVar#143|))
NIL))
- (RETURN (NREVERSE |bfVar#142|)))
+ (RETURN (NREVERSE |bfVar#144|)))
(T
- (SETQ |bfVar#142|
+ (SETQ |bfVar#144|
(CONS
(|genECLnativeTranslation,sharpArg|
|i| |x|)
- |bfVar#142|))))
+ |bfVar#144|))))
(SETQ |i| (+ |i| 1))
- (SETQ |bfVar#141|
- (CDR |bfVar#141|))))
+ (SETQ |bfVar#143|
+ (CDR |bfVar#143|))))
(CONS ")" NIL)))))
- (|bfVar#144| NIL))
+ (|bfVar#146| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#145|)
- (PROGN (SETQ |bfVar#144| (CAR |bfVar#145|)) NIL))
- (RETURN |bfVar#143|))
- (T (SETQ |bfVar#143| (CONCAT |bfVar#143| |bfVar#144|))))
- (SETQ |bfVar#145| (CDR |bfVar#145|)))))
+ ((OR (ATOM |bfVar#147|)
+ (PROGN (SETQ |bfVar#146| (CAR |bfVar#147|)) NIL))
+ (RETURN |bfVar#145|))
+ (T (SETQ |bfVar#145| (CONCAT |bfVar#145| |bfVar#146|))))
+ (SETQ |bfVar#147| (CDR |bfVar#147|)))))
(DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|)
(COND
@@ -2536,18 +2545,6 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#147| NIL) (|bfVar#146| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#146|)
- (PROGN (SETQ |x| (CAR |bfVar#146|)) NIL))
- (RETURN (NREVERSE |bfVar#147|)))
- (T (SETQ |bfVar#147|
- (CONS (|nativeArgumentType| |x|)
- |bfVar#147|))))
- (SETQ |bfVar#146| (CDR |bfVar#146|)))))
- (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
- (SETQ |parms|
(LET ((|bfVar#149| NIL) (|bfVar#148| |s|) (|x| NIL))
(LOOP
(COND
@@ -2555,19 +2552,31 @@
(PROGN (SETQ |x| (CAR |bfVar#148|)) NIL))
(RETURN (NREVERSE |bfVar#149|)))
(T (SETQ |bfVar#149|
- (CONS (GENSYM "parm") |bfVar#149|))))
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#149|))))
(SETQ |bfVar#148| (CDR |bfVar#148|)))))
+ (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
+ (SETQ |parms|
+ (LET ((|bfVar#151| NIL) (|bfVar#150| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#150|)
+ (PROGN (SETQ |x| (CAR |bfVar#150|)) NIL))
+ (RETURN (NREVERSE |bfVar#151|)))
+ (T (SETQ |bfVar#151|
+ (CONS (GENSYM "parm") |bfVar#151|))))
+ (SETQ |bfVar#150| (CDR |bfVar#150|)))))
(SETQ |unstableArgs| NIL)
- (LET ((|bfVar#150| |parms|) (|p| NIL) (|bfVar#151| |s|)
- (|x| NIL) (|bfVar#152| |argtypes|) (|y| NIL))
+ (LET ((|bfVar#152| |parms|) (|p| NIL) (|bfVar#153| |s|)
+ (|x| NIL) (|bfVar#154| |argtypes|) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#150|)
- (PROGN (SETQ |p| (CAR |bfVar#150|)) NIL)
- (ATOM |bfVar#151|)
- (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL)
- (ATOM |bfVar#152|)
- (PROGN (SETQ |y| (CAR |bfVar#152|)) NIL))
+ ((OR (ATOM |bfVar#152|)
+ (PROGN (SETQ |p| (CAR |bfVar#152|)) NIL)
+ (ATOM |bfVar#153|)
+ (PROGN (SETQ |x| (CAR |bfVar#153|)) NIL)
+ (ATOM |bfVar#154|)
+ (PROGN (SETQ |y| (CAR |bfVar#154|)) NIL))
(RETURN NIL))
(T (COND
((|needsStableReference?| |x|)
@@ -2575,31 +2584,31 @@
(SETQ |unstableArgs|
(CONS (CONS |p| (CONS |x| |y|))
|unstableArgs|)))))))
- (SETQ |bfVar#150| (CDR |bfVar#150|))
- (SETQ |bfVar#151| (CDR |bfVar#151|))
- (SETQ |bfVar#152| (CDR |bfVar#152|))))
+ (SETQ |bfVar#152| (CDR |bfVar#152|))
+ (SETQ |bfVar#153| (CDR |bfVar#153|))
+ (SETQ |bfVar#154| (CDR |bfVar#154|))))
(SETQ |foreignDecl|
(LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
(LIST :NAME (SYMBOL-NAME |op'|))
(CONS :ARGUMENTS
- (LET ((|bfVar#155| NIL)
- (|bfVar#153| |argtypes|) (|x| NIL)
- (|bfVar#154| |parms|) (|a| NIL))
+ (LET ((|bfVar#157| NIL)
+ (|bfVar#155| |argtypes|) (|x| NIL)
+ (|bfVar#156| |parms|) (|a| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#153|)
+ ((OR (ATOM |bfVar#155|)
(PROGN
- (SETQ |x| (CAR |bfVar#153|))
+ (SETQ |x| (CAR |bfVar#155|))
NIL)
- (ATOM |bfVar#154|)
+ (ATOM |bfVar#156|)
(PROGN
- (SETQ |a| (CAR |bfVar#154|))
+ (SETQ |a| (CAR |bfVar#156|))
NIL))
- (RETURN (NREVERSE |bfVar#155|)))
- (T (SETQ |bfVar#155|
- (CONS (LIST |a| |x|) |bfVar#155|))))
- (SETQ |bfVar#153| (CDR |bfVar#153|))
- (SETQ |bfVar#154| (CDR |bfVar#154|)))))
+ (RETURN (NREVERSE |bfVar#157|)))
+ (T (SETQ |bfVar#157|
+ (CONS (LIST |a| |x|) |bfVar#157|))))
+ (SETQ |bfVar#155| (CDR |bfVar#155|))
+ (SETQ |bfVar#156| (CDR |bfVar#156|)))))
(LIST :RETURN-TYPE |rettype|)
(LIST :LANGUAGE :STDC)))
(SETQ |forwardingFun|
@@ -2607,66 +2616,66 @@
((NULL |unstableArgs|)
(LIST 'DEFUN |op| |parms| (CONS |n| |parms|)))
(T (SETQ |localPairs|
- (LET ((|bfVar#158| NIL)
- (|bfVar#157| |unstableArgs|)
- (|bfVar#156| NIL))
+ (LET ((|bfVar#160| NIL)
+ (|bfVar#159| |unstableArgs|)
+ (|bfVar#158| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#157|)
+ ((OR (ATOM |bfVar#159|)
(PROGN
- (SETQ |bfVar#156|
- (CAR |bfVar#157|))
+ (SETQ |bfVar#158|
+ (CAR |bfVar#159|))
NIL))
- (RETURN (NREVERSE |bfVar#158|)))
- (T (AND (CONSP |bfVar#156|)
+ (RETURN (NREVERSE |bfVar#160|)))
+ (T (AND (CONSP |bfVar#158|)
(PROGN
- (SETQ |a| (CAR |bfVar#156|))
+ (SETQ |a| (CAR |bfVar#158|))
(SETQ |ISTMP#1|
- (CDR |bfVar#156|))
+ (CDR |bfVar#158|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |y| (CDR |ISTMP#1|))
T)))
- (SETQ |bfVar#158|
+ (SETQ |bfVar#160|
(CONS
(CONS |a|
(CONS |x|
(CONS |y| (GENSYM "loc"))))
- |bfVar#158|)))))
- (SETQ |bfVar#157| (CDR |bfVar#157|)))))
+ |bfVar#160|)))))
+ (SETQ |bfVar#159| (CDR |bfVar#159|)))))
(SETQ |call|
(CONS |n|
- (LET ((|bfVar#160| NIL)
- (|bfVar#159| |parms|) (|p| NIL))
+ (LET ((|bfVar#162| NIL)
+ (|bfVar#161| |parms|) (|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#159|)
+ ((OR (ATOM |bfVar#161|)
(PROGN
- (SETQ |p| (CAR |bfVar#159|))
+ (SETQ |p| (CAR |bfVar#161|))
NIL))
- (RETURN (NREVERSE |bfVar#160|)))
+ (RETURN (NREVERSE |bfVar#162|)))
(T
- (SETQ |bfVar#160|
+ (SETQ |bfVar#162|
(CONS
(|genCLISPnativeTranslation,actualArg|
|p| |localPairs|)
- |bfVar#160|))))
- (SETQ |bfVar#159| (CDR |bfVar#159|))))))
+ |bfVar#162|))))
+ (SETQ |bfVar#161| (CDR |bfVar#161|))))))
(SETQ |call|
(PROGN
(SETQ |fixups|
- (LET ((|bfVar#162| NIL)
- (|bfVar#161| |localPairs|)
+ (LET ((|bfVar#164| NIL)
+ (|bfVar#163| |localPairs|)
(|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#161|)
+ ((OR (ATOM |bfVar#163|)
(PROGN
- (SETQ |p| (CAR |bfVar#161|))
+ (SETQ |p| (CAR |bfVar#163|))
NIL))
(RETURN
- (NREVERSE |bfVar#162|)))
+ (NREVERSE |bfVar#164|)))
(T
(AND
(NOT
@@ -2674,26 +2683,26 @@
(SETQ |q|
(|genCLISPnativeTranslation,copyBack|
|p|))))
- (SETQ |bfVar#162|
- (CONS |q| |bfVar#162|)))))
- (SETQ |bfVar#161|
- (CDR |bfVar#161|)))))
+ (SETQ |bfVar#164|
+ (CONS |q| |bfVar#164|)))))
+ (SETQ |bfVar#163|
+ (CDR |bfVar#163|)))))
(COND
((NULL |fixups|) (LIST |call|))
(T (LIST (CONS 'PROG1
(CONS |call| |fixups|)))))))
- (LET ((|bfVar#164| |localPairs|) (|bfVar#163| NIL))
+ (LET ((|bfVar#166| |localPairs|) (|bfVar#165| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#164|)
+ ((OR (ATOM |bfVar#166|)
(PROGN
- (SETQ |bfVar#163| (CAR |bfVar#164|))
+ (SETQ |bfVar#165| (CAR |bfVar#166|))
NIL))
(RETURN NIL))
- (T (AND (CONSP |bfVar#163|)
+ (T (AND (CONSP |bfVar#165|)
(PROGN
- (SETQ |p| (CAR |bfVar#163|))
- (SETQ |ISTMP#1| (CDR |bfVar#163|))
+ (SETQ |p| (CAR |bfVar#165|))
+ (SETQ |ISTMP#1| (CDR |bfVar#165|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
@@ -2716,18 +2725,18 @@
|p|)
|p|)
|call|)))))))
- (SETQ |bfVar#164| (CDR |bfVar#164|))))
+ (SETQ |bfVar#166| (CDR |bfVar#166|))))
(CONS 'DEFUN (CONS |op| (CONS |parms| |call|))))))
(SETQ |$foreignsDefsForCLisp|
(CONS |foreignDecl| |$foreignsDefsForCLisp|))
(LIST |forwardingFun|)))))
-(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#165|)
+(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#167|)
(PROG (|a| |y| |x| |p|)
(RETURN
(PROGN
- (SETQ |p| (CAR |bfVar#165|))
- (SETQ |x| (CADR . #0=(|bfVar#165|)))
+ (SETQ |p| (CAR |bfVar#167|))
+ (SETQ |x| (CADR . #0=(|bfVar#167|)))
(SETQ |y| (CADDR . #0#))
(SETQ |a| (CDDDR . #0#))
(COND
@@ -2751,35 +2760,35 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#167| NIL) (|bfVar#166| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#166|)
- (PROGN (SETQ |x| (CAR |bfVar#166|)) NIL))
- (RETURN (NREVERSE |bfVar#167|)))
- (T (SETQ |bfVar#167|
- (CONS (|nativeArgumentType| |x|)
- |bfVar#167|))))
- (SETQ |bfVar#166| (CDR |bfVar#166|)))))
- (SETQ |args|
(LET ((|bfVar#169| NIL) (|bfVar#168| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#168|)
(PROGN (SETQ |x| (CAR |bfVar#168|)) NIL))
(RETURN (NREVERSE |bfVar#169|)))
- (T (SETQ |bfVar#169| (CONS (GENSYM) |bfVar#169|))))
+ (T (SETQ |bfVar#169|
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#169|))))
(SETQ |bfVar#168| (CDR |bfVar#168|)))))
+ (SETQ |args|
+ (LET ((|bfVar#171| NIL) (|bfVar#170| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#170|)
+ (PROGN (SETQ |x| (CAR |bfVar#170|)) NIL))
+ (RETURN (NREVERSE |bfVar#171|)))
+ (T (SETQ |bfVar#171| (CONS (GENSYM) |bfVar#171|))))
+ (SETQ |bfVar#170| (CDR |bfVar#170|)))))
(SETQ |unstableArgs| NIL)
(SETQ |newArgs| NIL)
- (LET ((|bfVar#170| |args|) (|a| NIL) (|bfVar#171| |s|)
+ (LET ((|bfVar#172| |args|) (|a| NIL) (|bfVar#173| |s|)
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#170|)
- (PROGN (SETQ |a| (CAR |bfVar#170|)) NIL)
- (ATOM |bfVar#171|)
- (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL))
+ ((OR (ATOM |bfVar#172|)
+ (PROGN (SETQ |a| (CAR |bfVar#172|)) NIL)
+ (ATOM |bfVar#173|)
+ (PROGN (SETQ |x| (CAR |bfVar#173|)) NIL))
(RETURN NIL))
(T (PROGN
(SETQ |newArgs|
@@ -2788,8 +2797,8 @@
(COND
((|needsStableReference?| |x|)
(SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))))
- (SETQ |bfVar#170| (CDR |bfVar#170|))
- (SETQ |bfVar#171| (CDR |bfVar#171|))))
+ (SETQ |bfVar#172| (CDR |bfVar#172|))
+ (SETQ |bfVar#173| (CDR |bfVar#173|))))
(SETQ |op'|
(COND
((|%hasFeature| :WIN32)
@@ -2827,17 +2836,6 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#173| NIL) (|bfVar#172| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#172|)
- (PROGN (SETQ |x| (CAR |bfVar#172|)) NIL))
- (RETURN (NREVERSE |bfVar#173|)))
- (T (SETQ |bfVar#173|
- (CONS (|nativeArgumentType| |x|)
- |bfVar#173|))))
- (SETQ |bfVar#172| (CDR |bfVar#172|)))))
- (SETQ |parms|
(LET ((|bfVar#175| NIL) (|bfVar#174| |s|) (|x| NIL))
(LOOP
(COND
@@ -2845,18 +2843,29 @@
(PROGN (SETQ |x| (CAR |bfVar#174|)) NIL))
(RETURN (NREVERSE |bfVar#175|)))
(T (SETQ |bfVar#175|
- (CONS (GENSYM "parm") |bfVar#175|))))
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#175|))))
(SETQ |bfVar#174| (CDR |bfVar#174|)))))
+ (SETQ |parms|
+ (LET ((|bfVar#177| NIL) (|bfVar#176| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#176|)
+ (PROGN (SETQ |x| (CAR |bfVar#176|)) NIL))
+ (RETURN (NREVERSE |bfVar#177|)))
+ (T (SETQ |bfVar#177|
+ (CONS (GENSYM "parm") |bfVar#177|))))
+ (SETQ |bfVar#176| (CDR |bfVar#176|)))))
(SETQ |strPairs| NIL)
(SETQ |aryPairs| NIL)
- (LET ((|bfVar#176| |parms|) (|p| NIL) (|bfVar#177| |s|)
+ (LET ((|bfVar#178| |parms|) (|p| NIL) (|bfVar#179| |s|)
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#176|)
- (PROGN (SETQ |p| (CAR |bfVar#176|)) NIL)
- (ATOM |bfVar#177|)
- (PROGN (SETQ |x| (CAR |bfVar#177|)) NIL))
+ ((OR (ATOM |bfVar#178|)
+ (PROGN (SETQ |p| (CAR |bfVar#178|)) NIL)
+ (ATOM |bfVar#179|)
+ (PROGN (SETQ |x| (CAR |bfVar#179|)) NIL))
(RETURN NIL))
(T (COND
((EQ |x| '|string|)
@@ -2878,33 +2887,33 @@
(NULL (CDR |ISTMP#3|)))))))))
(SETQ |aryPairs|
(CONS (CONS |p| (GENSYM "loc")) |aryPairs|))))))
- (SETQ |bfVar#176| (CDR |bfVar#176|))
- (SETQ |bfVar#177| (CDR |bfVar#177|))))
+ (SETQ |bfVar#178| (CDR |bfVar#178|))
+ (SETQ |bfVar#179| (CDR |bfVar#179|))))
(COND
((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT '_ |op'|))))
(SETQ |call|
(CONS (|bfColonColon| 'CCL 'EXTERNAL-CALL)
(CONS (STRING |op'|)
- (APPEND (LET ((|bfVar#180| NIL)
- (|bfVar#178| |argtypes|)
- (|x| NIL) (|bfVar#179| |parms|)
+ (APPEND (LET ((|bfVar#182| NIL)
+ (|bfVar#180| |argtypes|)
+ (|x| NIL) (|bfVar#181| |parms|)
(|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#178|)
+ ((OR (ATOM |bfVar#180|)
(PROGN
(SETQ |x|
- (CAR |bfVar#178|))
+ (CAR |bfVar#180|))
NIL)
- (ATOM |bfVar#179|)
+ (ATOM |bfVar#181|)
(PROGN
(SETQ |p|
- (CAR |bfVar#179|))
+ (CAR |bfVar#181|))
NIL))
(RETURN
- (NREVERSE |bfVar#180|)))
+ (NREVERSE |bfVar#182|)))
(T
- (SETQ |bfVar#180|
+ (SETQ |bfVar#182|
(APPEND
(REVERSE
(LIST |x|
@@ -2916,45 +2925,45 @@
(ASSOC |p| |aryPairs|))
(CDR |p'|))
(T |p|))))
- |bfVar#180|))))
- (SETQ |bfVar#178|
- (CDR |bfVar#178|))
- (SETQ |bfVar#179|
- (CDR |bfVar#179|))))
+ |bfVar#182|))))
+ (SETQ |bfVar#180|
+ (CDR |bfVar#180|))
+ (SETQ |bfVar#181|
+ (CDR |bfVar#181|))))
(CONS |rettype| NIL)))))
(COND
((EQ |t| '|string|)
(SETQ |call|
(LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|))))
- (LET ((|bfVar#181| |aryPairs|) (|arg| NIL))
+ (LET ((|bfVar#183| |aryPairs|) (|arg| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#181|)
- (PROGN (SETQ |arg| (CAR |bfVar#181|)) NIL))
+ ((OR (ATOM |bfVar#183|)
+ (PROGN (SETQ |arg| (CAR |bfVar#183|)) NIL))
(RETURN NIL))
(T (SETQ |call|
(LIST (|bfColonColon| 'CCL
'WITH-POINTER-TO-IVECTOR)
(LIST (CDR |arg|) (CAR |arg|)) |call|))))
- (SETQ |bfVar#181| (CDR |bfVar#181|))))
+ (SETQ |bfVar#183| (CDR |bfVar#183|))))
(COND
(|strPairs|
(SETQ |call|
(LIST (|bfColonColon| 'CCL 'WITH-CSTRS)
- (LET ((|bfVar#183| NIL)
- (|bfVar#182| |strPairs|) (|arg| NIL))
+ (LET ((|bfVar#185| NIL)
+ (|bfVar#184| |strPairs|) (|arg| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#182|)
+ ((OR (ATOM |bfVar#184|)
(PROGN
- (SETQ |arg| (CAR |bfVar#182|))
+ (SETQ |arg| (CAR |bfVar#184|))
NIL))
- (RETURN (NREVERSE |bfVar#183|)))
- (T (SETQ |bfVar#183|
+ (RETURN (NREVERSE |bfVar#185|)))
+ (T (SETQ |bfVar#185|
(CONS
(LIST (CDR |arg|) (CAR |arg|))
- |bfVar#183|))))
- (SETQ |bfVar#182| (CDR |bfVar#182|))))
+ |bfVar#185|))))
+ (SETQ |bfVar#184| (CDR |bfVar#184|))))
|call|))))
(LIST (LIST 'DEFUN |op| |parms| |call|))))))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 8498e086..55781f24 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -840,6 +840,8 @@
(COND
((|bpEqPeek| 'BEC) (|bpRestore| |a|)
(OR (|bpAssignment|) (|bpTrap|)))
+ ((|bpEqPeek| 'GIVES) (|bpRestore| |a|)
+ (OR (|bpLambda|) (|bpTrap|)))
(T T)))
(T (|bpRestore| |a|) NIL))))))
@@ -848,6 +850,10 @@
(OR (|bpAssign|) (|bpTrap|))
(|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))))
+(DEFUN |bpLambda| ()
+ (AND (|bpVariable|) (|bpEqKey| 'GIVES) (OR (|bpAssign|) (|bpTrap|))
+ (|bpPush| (|bfLambda| (|bpPop2|) (|bpPop1|)))))
+
(DEFUN |bpExit| ()
(AND (|bpAssign|)
(OR (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index ba6fe1e6..897bea78 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -24,11 +24,11 @@
(LIST "=" 'SHOEEQ) (LIST "^" 'NOTRETIRED)
(LIST "^=" 'SHOENERETIRED) (LIST "~=" 'SHOENE)
(LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
- (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "==" 'DEF)
- (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
- (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK)
- (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR)
- (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
+ (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "+->" 'GIVES)
+ (LIST "==" 'DEF) (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF)
+ (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK)
+ (LIST "|)" 'CBRACK) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK)
+ (LIST "suchthat" 'BAR) (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
(DEFUN |shoeKeyTableCons| ()
(PROG (|KeyTable|)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 8f627aac..597ac295 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -88,6 +88,7 @@ shoeKeyWords == [ _
['"=>","EXIT" ], _
['"->", "ARROW"],_
['":=", "BEC"], _
+ ['"+->", "GIVES"], _
['"==", "DEF"], _
['"==>","MDEF" ], _
['"<=>", "TDEF"], _
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 9a51fc2a..9325efb1 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1506,7 +1506,7 @@ mutateToBackendCode x ==
$LocalVars := [y,:$LocalVars]
newBindings := [y,:newBindings]
res := mutateToBackendCode CDDR x
- $LocalVars := REMOVE_-IF(function LAMBDA(y(), y in newBindings),
+ $LocalVars := REMOVE_-IF(function (y +-> y in newBindings),
$LocalVars)
[u,second x,:res]
u = "DECLARE" => nil -- there is nothing to do convert there
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index 6f13f2dd..d8d89c95 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -204,15 +204,15 @@ npPPff f ==
FUNCALL f and npPush [npPop1()]
npPPf f ==
- npSemiListing function LAMBDA(nil, npPPff f)
+ npSemiListing function (() +-> npPPff f)
npPPg f ==
- npListAndRecover function LAMBDA(nil, npPPf f)
+ npListAndRecover function (() +-> npPPf f)
and npPush pfAppend npPop1()
npPP(f) ==
- npParened function LAMBDA(nil, npPPf f)
- or npPileBracketed function LAMBDA(nil, npPPg f) and
+ npParened function (() +-> npPPf f)
+ or npPileBracketed function (() +-> npPPg f) and
npPush pfEnSequence npPop1()
or FUNCALL f
@@ -220,11 +220,11 @@ npPCff f ==
FUNCALL f and npPush [npPop1()]
npPCg f ==
- npListAndRecover function LAMBDA(nil,npPCff f)
+ npListAndRecover function (() +-> npPCff f)
and npPush pfAppend npPop1()
npPC(f) ==
- npPileBracketed function LAMBDA(nil, npPCg f) and
+ npPileBracketed function (() +-> npPCg f) and
npPush pfEnSequence npPop1()
or FUNCALL f
@@ -615,7 +615,7 @@ npBackTrack(p1,p2,p3)==
npMDEF() ==
npBackTrack(function npStatement,"MDEF",
- function LAMBDA(nil, npMdef "MDEF"))
+ function (() +-> npMdef "MDEF"))
npAssign()== npBackTrack(function npMDEF,"BECOMES",function npAssignment)
@@ -647,7 +647,7 @@ npGives()== npBackTrack(function npExit,"GIVES",function npLambda)
npDefinitionOrStatement()==
npQuantified
- function LAMBDA(nil, npBackTrack(function npGives,
+ function (() +-> npBackTrack(function npGives,
"DEF",function npDef))
npVoid()== npAndOr("DO",function npStatement,function pfNovalue)
@@ -724,7 +724,7 @@ npFix()== npEqKey "FIX" and npPP function npDef
and npPush pfFix npPop1 ()
npMacro() ==
- npEqKey "MACRO" and npPP function LAMBDA(nil, npMdef "DEF")
+ npEqKey "MACRO" and npPP function (() +-> npMdef "DEF")
npRule()== npEqKey "RULE" and npPP function npSingleRule
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 22:10:08 +0000