* boot/ast.boot (shoeCompTran1): Handle %Leave expressions.

	* boot/parser.boot (bpReturn): Parse leave-expressions too.
	* interp/mark.boot (markInsertBodyParts): properly escape Boot
	keywords. 

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]]