aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog7
-rw-r--r--src/boot/ast.boot1
-rw-r--r--src/boot/parser.boot8
-rw-r--r--src/boot/strap/ast.clisp1
-rw-r--r--src/boot/strap/parser.clisp2
-rw-r--r--src/interp/mark.boot6
-rw-r--r--src/interp/pspad2.boot2
7 files changed, 20 insertions, 7 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d2ade349..44350ede 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
2010-05-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/ast.boot (shoeCompTran1): Handle %Leave expressions.
+ * boot/parser.boot (bpReturn): Parse leave-expressions too.
+ * interp/mark.boot (markInsertBodyParts): properly escape Boot
+ keywords.
+
+2010-05-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/vmlisp.lisp (SETELT): Remove.
* interp/br-data.boot: Remove use of SETELT.
* interp/br-saturn.boot: Likewise.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 878bb755..e386f405 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -927,6 +927,7 @@ shoeCompTran1 x==
MEMQ(second l,$fluidVars)=>$fluidVars
[second l,:$fluidVars]
x.rest.first := second l
+ U = "%Leave" => x.first := "RETURN"
U in '(PROG LAMBDA) =>
newbindings:=nil
for y in second x repeat
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index e754375d..9525c6db 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -734,11 +734,15 @@ bpLeave() ==
++ Return:
++ RETURN Assign
+++ Leave
+++ Throw
+++ And
bpReturn()==
(bpEqKey "RETURN" and (bpAssign() or bpTrap()) and
bpPush bfReturnNoName bpPop1())
- or bpThrow()
- or bpAnd()
+ or bpLeave()
+ or bpThrow()
+ or bpAnd()
bpLogical()== bpLeftAssoc('(OR),function bpReturn)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index a754c468..a899f5ed 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1596,6 +1596,7 @@
((MEMQ (CADR |l|) |$fluidVars|) |$fluidVars|)
(T (CONS (CADR |l|) |$fluidVars|))))
(RPLACA (CDR |x|) (CADR |l|)))))
+ ((EQ U '|%Leave|) (RPLACA |x| 'RETURN))
((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
(LET ((|bfVar#110| (CADR |x|)) (|y| NIL))
(LOOP
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 55781f24..89d4bfa6 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -771,7 +771,7 @@
(DEFUN |bpReturn| ()
(OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|))
(|bpPush| (|bfReturnNoName| (|bpPop1|))))
- (|bpThrow|) (|bpAnd|)))
+ (|bpLeave|) (|bpThrow|) (|bpAnd|)))
(DEFUN |bpLogical| () (|bpLeftAssoc| '(OR) #'|bpReturn|))
diff --git a/src/interp/mark.boot b/src/interp/mark.boot
index 9217acb2..ebaa4475 100644
--- a/src/interp/mark.boot
+++ b/src/interp/mark.boot
@@ -1154,11 +1154,11 @@ markInsertBodyParts u ==
--u is ["%LET",a,b] and constructor? opOf b => u
u is ["%LET",a,b] and a is [op,:.] =>
["%LET",[markWrapPart x for x in a],markInsertBodyParts b]
- u is [op,a,b] and op in '(_add _with IN %LET) =>
+ u is [op,a,b] and op in '(add with IN %LET) =>
[op,markInsertBodyParts a,markInsertBodyParts b]
- u is [op,a,b] and op in '(_: _:_: _pretend _@) =>
+ u is [op,a,b] and op in '(_: _:_: pretend _@) =>
[op,markInsertBodyParts a,b]
- u is [op,a,:x] and op in '(STEP return leave exit reduce) =>
+ u is [op,a,:x] and op in '(STEP _return _leave exit reduce) =>
[op,a,:[markInsertBodyParts y for y in x]]
u is [op,:x] and markPartOp? op => [op,:[markWrapPart y for y in x]]
u is [op,:.] and constructor? op => u
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
index f181c5d0..4e11875a 100644
--- a/src/interp/pspad2.boot
+++ b/src/interp/pspad2.boot
@@ -168,7 +168,7 @@ formatDeftranREPEAT(itl,body) ==
u := [x for x in itl | x is ["UNTIL",p]] or return nil
nitl := SETDIFFERENCE(itl,u)
pred := MKPF([p for ['UNTIL,p] in u],'or)
- cond := ['IF,pred,['leave,n,nil],'%noBranch]
+ cond := ['IF,pred,["leave",n,nil],'%noBranch]
nbody :=
body is ['SEQ,:l,[.,n,x]] => ['SEQ,:l,x,['exit,n,cond]]
['SEQ,body,['exit,n,cond]]