* boot/ast.boot (shoeCompTran): Simplify.

	(shoeCompTran1): Partially defer translation of fluid variable
	definition.
	(bindFluidVars!): New. Complete translation.
	(groupFluidVars): New.
	* interp/newfort.boot (fortFormatIntrinsics): Remove redundant return.

7 files changed, 303 insertions, 173 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 190ef488..3a025966 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2012-05-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/ast.boot (shoeCompTran): Simplify.
+	(shoeCompTran1): Partially defer translation of fluid variable
+	definition.
+	(bindFluidVars!): New. Complete translation.
+	(groupFluidVars): New.
+	* interp/newfort.boot (fortFormatIntrinsics): Remove redundant return.
+
 2012-05-19  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/ast.boot (shoeCompTran1): Take variable sets by reference.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index a6095248..f4f4bedc 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -1003,15 +1003,12 @@ shoeCompTran x==
   shoeCompTran1(body,fluidVars,locVars,dollarVars)
   deref(locVars) := setDifference(setDifference(deref locVars,deref fluidVars),shoeATOMs args)
   body :=
-    lvars := append(deref fluidVars,deref locVars)
-    deref(fluidVars) := setUnion(deref fluidVars,deref dollarVars)
     body' := body
     if $typings then
       body' := [["DECLARE",:$typings],:body']
-    if deref fluidVars then
-      fvars := ["DECLARE",["SPECIAL",:deref fluidVars]]
-      body' := [fvars,:body']
-    lvars or needsPROG body => shoePROG(lvars,body')
+    if fvars := setDifference(deref dollarVars,deref fluidVars) then
+      body' := [["DECLARE",["SPECIAL",:fvars]],:body']
+    deref locVars or needsPROG body' => shoePROG(deref locVars,body')
     body'
   if fl := shoeFluids args then
     body := [["DECLARE",["SPECIAL",:fl]],:body]
@@ -1021,7 +1018,7 @@ needsPROG body ==
   body isnt [.,:.] => false
   [op,:args] := body
   op in '(RETURN RETURN_-FROM) => true
-  op in '(LET PROG LOOP BLOCK DECLARE LAMBDA) => false
+  op in '(LET LET_*  PROG LOOP BLOCK DECLARE LAMBDA) => false
   or/[needsPROG t for t in body]
 
 shoePROG(v,b)==
@@ -1065,8 +1062,14 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) ==
       zs := rest zs
     x
   x is ["L%T",l,r] =>
-    x.op := "SETQ"
     third(x) := shoeCompTran1(r,fluidVars,locVars,dollarVars)
+    l is ['%Dynamic,y] =>
+      if not symbolMember?(y,deref fluidVars) then
+        deref(fluidVars) := [y,:deref fluidVars]
+      -- Defer translation of operator for this form.
+      second(x) := y
+      x
+    x.op := "SETQ"
     symbol? l =>
       bfBeginsDollar l =>
         if not symbolMember?(l,deref dollarVars) then
@@ -1075,11 +1078,7 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) ==
       if not symbolMember?(l,deref locVars) then
         deref(locVars) := [l,:deref locVars]
       x
-    l is ['%Dynamic,:.] =>
-      if not symbolMember?(second l,deref fluidVars) then
-        deref(fluidVars) := [second l,:deref fluidVars]
-      x.rest.first := second l
-      x
+    x
   U is "%Leave" => (x.op := "RETURN"; x)
   U in '(PROG LAMBDA) =>
     newbindings := nil
@@ -1112,8 +1111,25 @@ shoeCompTran1(x,fluidVars,locVars,dollarVars) ==
     ["FIND-PACKAGE",symbolName n]
   x.first := shoeCompTran1(first x,fluidVars,locVars,dollarVars)
   x.rest := shoeCompTran1(rest x,fluidVars,locVars,dollarVars)
-  x
+  bindFluidVars! x
  
+bindFluidVars! x ==
+  if x is [["L%T",:init],:stmts] then
+    x.first := groupFluidVars([init],[first init],stmts)
+    x.rest := nil
+  x is ["PROGN",y] => y
+  x
+
+groupFluidVars(inits,vars,stmts) ==
+  stmts is [["LET",inits',["DECLARE",["SPECIAL",:vars']],:stmts']]
+    and inits' is [.] =>
+      groupFluidVars([:inits,:inits'],[:vars,:vars'],stmts')
+  stmts is [["LET*",inits',["DECLARE",["SPECIAL",:vars']],:stmts']] =>
+    groupFluidVars([:inits,:inits'],[:vars,:vars'],stmts')
+  inits is [.] =>
+    ["LET",inits,["DECLARE",["SPECIAL",:vars]],bfMKPROGN stmts]
+  ["LET*",inits,["DECLARE",["SPECIAL",:vars]],bfMKPROGN stmts]
+
 bfTagged(a,b)==
   $op = nil => %Signature(a,b)        -- surely a toplevel decl
   symbol? a =>
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 8ec1bc57..0eb9fefd 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -995,9 +995,9 @@
             (LIST 'COND (LIST |isPred| |rhs|)))))))
 
 (DEFUN |bfLET| (|lhs| |rhs|)
-  (PROG (|$letGenVarCounter|)
+  (LET ((|$letGenVarCounter| 0))
     (DECLARE (SPECIAL |$letGenVarCounter|))
-    (RETURN (PROGN (SETQ |$letGenVarCounter| 0) (|bfLET1| |lhs| |rhs|)))))
+    (|bfLET1| |lhs| |rhs|)))
 
 (DEFUN |addCARorCDR| (|acc| |expr|)
   (PROG (|funsR| |funsA| |p| |funs|)
@@ -1034,13 +1034,9 @@
         (T (LIST |op| |left| |right|))))
 
 (DEFUN |bfIS| (|left| |right|)
-  (PROG (|$inDefIS| |$isGenVarCounter|)
-    (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|))
-    (RETURN
-     (PROGN
-      (SETQ |$isGenVarCounter| 0)
-      (SETQ |$inDefIS| T)
-      (|bfIS1| |left| |right|)))))
+  (LET* ((|$isGenVarCounter| 0) (|$inDefIS| T))
+    (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|))
+    (|bfIS1| |left| |right|)))
 
 (DEFUN |bfISReverse| (|x| |a|)
   (PROG (|y|)
@@ -1707,8 +1703,8 @@
                               |body|))))))))))))
 
 (DEFUN |shoeCompTran| (|x|)
-  (PROG (|fl| |fvars| |body'| |lvars| |dollarVars| |locVars| |fluidVars| |body|
-         |args| |lamtype|)
+  (PROG (|fl| |fvars| |body'| |dollarVars| |locVars| |fluidVars| |body| |args|
+         |lamtype|)
     (DECLARE (SPECIAL |$typings|))
     (RETURN
      (PROGN
@@ -1725,23 +1721,20 @@
                (|shoeATOMs| |args|)))
       (SETQ |body|
               (PROGN
-               (SETQ |lvars|
-                       (|append| (|deref| |fluidVars|) (|deref| |locVars|)))
-               (SETF (|deref| |fluidVars|)
-                       (|setUnion| (|deref| |fluidVars|)
-                                   (|deref| |dollarVars|)))
                (SETQ |body'| |body|)
                (COND
                 (|$typings|
                  (SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|))))
                (COND
-                ((|deref| |fluidVars|)
-                 (SETQ |fvars|
-                         (LIST 'DECLARE (CONS 'SPECIAL (|deref| |fluidVars|))))
-                 (SETQ |body'| (CONS |fvars| |body'|))))
+                ((SETQ |fvars|
+                         (|setDifference| (|deref| |dollarVars|)
+                                          (|deref| |fluidVars|)))
+                 (SETQ |body'|
+                         (CONS (LIST 'DECLARE (CONS 'SPECIAL |fvars|))
+                               |body'|))))
                (COND
-                ((OR |lvars| (|needsPROG| |body|))
-                 (|shoePROG| |lvars| |body'|))
+                ((OR (|deref| |locVars|) (|needsPROG| |body'|))
+                 (|shoePROG| (|deref| |locVars|) |body'|))
                 (T |body'|))))
       (COND
        ((SETQ |fl| (|shoeFluids| |args|))
@@ -1755,7 +1748,8 @@
            (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|))
             (COND ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T)
                   ((|symbolMember?| |op|
-                                    '(LET PROG
+                                    '(LET LET*
+                                       PROG
                                        LOOP
                                        BLOCK
                                        DECLARE
@@ -1846,29 +1840,36 @@
                           (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                           (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
-              (RPLACA |x| 'SETQ)
               (SETF (CADDR |x|)
                       (|shoeCompTran1| |r| |fluidVars| |locVars| |dollarVars|))
               (COND
-               ((SYMBOLP |l|)
-                (COND
-                 ((|bfBeginsDollar| |l|)
-                  (COND
-                   ((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
-                    (SETF (|deref| |dollarVars|)
-                            (CONS |l| (|deref| |dollarVars|)))))
-                  |x|)
-                 (T
-                  (COND
-                   ((NOT (|symbolMember?| |l| (|deref| |locVars|)))
-                    (SETF (|deref| |locVars|) (CONS |l| (|deref| |locVars|)))))
-                  |x|)))
-               ((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|))
+               ((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|)
+                     (PROGN
+                      (SETQ |ISTMP#1| (CDR |l|))
+                      (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+                           (PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
                 (COND
-                 ((NOT (|symbolMember?| (CADR |l|) (|deref| |fluidVars|)))
+                 ((NOT (|symbolMember?| |y| (|deref| |fluidVars|)))
                   (SETF (|deref| |fluidVars|)
-                          (CONS (CADR |l|) (|deref| |fluidVars|)))))
-                (RPLACA (CDR |x|) (CADR |l|)) |x|)))
+                          (CONS |y| (|deref| |fluidVars|)))))
+                (SETF (CADR |x|) |y|) |x|)
+               (T (RPLACA |x| 'SETQ)
+                (COND
+                 ((SYMBOLP |l|)
+                  (COND
+                   ((|bfBeginsDollar| |l|)
+                    (COND
+                     ((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
+                      (SETF (|deref| |dollarVars|)
+                              (CONS |l| (|deref| |dollarVars|)))))
+                    |x|)
+                   (T
+                    (COND
+                     ((NOT (|symbolMember?| |l| (|deref| |locVars|)))
+                      (SETF (|deref| |locVars|)
+                              (CONS |l| (|deref| |locVars|)))))
+                    |x|)))
+                 (T |x|)))))
              ((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|)
              ((|symbolMember?| U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
               (LET ((|bfVar#1| (CADR |x|)) (|y| NIL))
@@ -1946,7 +1947,101 @@
               (RPLACD |x|
                       (|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
                                        |dollarVars|))
-              |x|)))))))
+              (|bindFluidVars!| |x|))))))))
+
+(DEFUN |bindFluidVars!| (|x|)
+  (PROG (|y| |stmts| |init| |ISTMP#1|)
+    (RETURN
+     (PROGN
+      (COND
+       ((AND (CONSP |x|)
+             (PROGN
+              (SETQ |ISTMP#1| (CAR |x|))
+              (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T)
+                   (PROGN (SETQ |init| (CDR |ISTMP#1|)) T)))
+             (PROGN (SETQ |stmts| (CDR |x|)) T))
+        (RPLACA |x|
+                (|groupFluidVars| (LIST |init|) (LIST (CAR |init|)) |stmts|))
+        (RPLACD |x| NIL)))
+      (COND
+       ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)
+             (PROGN
+              (SETQ |ISTMP#1| (CDR |x|))
+              (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+                   (PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
+        |y|)
+       (T |x|))))))
+
+(DEFUN |groupFluidVars| (|inits| |vars| |stmts|)
+  (PROG (|stmts'| |vars'| |ISTMP#6| |ISTMP#5| |ISTMP#4| |ISTMP#3| |inits'|
+         |ISTMP#2| |ISTMP#1|)
+    (RETURN
+     (COND
+      ((AND (CONSP |stmts|) (NULL (CDR |stmts|))
+            (PROGN
+             (SETQ |ISTMP#1| (CAR |stmts|))
+             (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET)
+                  (PROGN
+                   (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                   (AND (CONSP |ISTMP#2|)
+                        (PROGN
+                         (SETQ |inits'| (CAR |ISTMP#2|))
+                         (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+                         (AND (CONSP |ISTMP#3|)
+                              (PROGN
+                               (SETQ |ISTMP#4| (CAR |ISTMP#3|))
+                               (AND (CONSP |ISTMP#4|)
+                                    (EQ (CAR |ISTMP#4|) 'DECLARE)
+                                    (PROGN
+                                     (SETQ |ISTMP#5| (CDR |ISTMP#4|))
+                                     (AND (CONSP |ISTMP#5|)
+                                          (NULL (CDR |ISTMP#5|))
+                                          (PROGN
+                                           (SETQ |ISTMP#6| (CAR |ISTMP#5|))
+                                           (AND (CONSP |ISTMP#6|)
+                                                (EQ (CAR |ISTMP#6|) 'SPECIAL)
+                                                (PROGN
+                                                 (SETQ |vars'| (CDR |ISTMP#6|))
+                                                 T)))))))
+                              (PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T)))))))
+            (CONSP |inits'|) (NULL (CDR |inits'|)))
+       (|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
+                         |stmts'|))
+      ((AND (CONSP |stmts|) (NULL (CDR |stmts|))
+            (PROGN
+             (SETQ |ISTMP#1| (CAR |stmts|))
+             (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET*)
+                  (PROGN
+                   (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                   (AND (CONSP |ISTMP#2|)
+                        (PROGN
+                         (SETQ |inits'| (CAR |ISTMP#2|))
+                         (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+                         (AND (CONSP |ISTMP#3|)
+                              (PROGN
+                               (SETQ |ISTMP#4| (CAR |ISTMP#3|))
+                               (AND (CONSP |ISTMP#4|)
+                                    (EQ (CAR |ISTMP#4|) 'DECLARE)
+                                    (PROGN
+                                     (SETQ |ISTMP#5| (CDR |ISTMP#4|))
+                                     (AND (CONSP |ISTMP#5|)
+                                          (NULL (CDR |ISTMP#5|))
+                                          (PROGN
+                                           (SETQ |ISTMP#6| (CAR |ISTMP#5|))
+                                           (AND (CONSP |ISTMP#6|)
+                                                (EQ (CAR |ISTMP#6|) 'SPECIAL)
+                                                (PROGN
+                                                 (SETQ |vars'| (CDR |ISTMP#6|))
+                                                 T)))))))
+                              (PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T))))))))
+       (|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
+                         |stmts'|))
+      ((AND (CONSP |inits|) (NULL (CDR |inits|)))
+       (LIST 'LET |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
+             (|bfMKPROGN| |stmts|)))
+      (T
+       (LIST 'LET* |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
+             (|bfMKPROGN| |stmts|)))))))
 
 (DEFUN |bfTagged| (|a| |b|)
   (DECLARE (SPECIAL |$typings| |$op|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index a03b67b9..c21669f2 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -91,29 +91,31 @@
       |a|))))
 
 (DEFUN |bpIndentParenthesized| (|f|)
-  (PROG (|$bpCount| |a|)
-    (DECLARE (SPECIAL |$bpCount| |$inputStream| |$bpParenCount| |$stok|))
+  (PROG (|a|)
+    (DECLARE (SPECIAL |$inputStream| |$bpParenCount| |$stok|))
     (RETURN
-     (PROGN
-      (SETQ |$bpCount| 0)
-      (SETQ |a| |$stok|)
-      (COND
-       ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
-        (|bpNext|)
+     (LET ((|$bpCount| 0))
+       (DECLARE (SPECIAL |$bpCount|))
+       (PROGN
+        (SETQ |a| |$stok|)
         (COND
-         ((AND (APPLY |f| NIL) (|bpFirstTok|)
-               (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
-          (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
-          (COND ((EQL |$bpCount| 0) T)
-                (T
-                 (SETQ |$inputStream|
-                         (|append| (|bpAddTokens| |$bpCount|) |$inputStream|))
-                 (|bpFirstToken|)
-                 (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
-         ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
-          (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
-         (T (|bpParenTrap| |a|))))
-       (T NIL))))))
+         ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
+          (|bpNext|)
+          (COND
+           ((AND (APPLY |f| NIL) (|bpFirstTok|)
+                 (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+            (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
+            (COND ((EQL |$bpCount| 0) T)
+                  (T
+                   (SETQ |$inputStream|
+                           (|append| (|bpAddTokens| |$bpCount|)
+                                     |$inputStream|))
+                   (|bpFirstToken|)
+                   (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
+           ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
+            (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
+           (T (|bpParenTrap| |a|))))
+         (T NIL)))))))
 
 (DEFUN |bpParenthesized| (|f|)
   (PROG (|a|)
@@ -1170,27 +1172,27 @@
        (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
 
 (DEFUN |bpOutItem| ()
-  (PROG (|$GenVarCounter| |$op| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
-    (DECLARE (SPECIAL |$GenVarCounter| |$op| |$InteractiveMode|))
+  (PROG (|r| |ISTMP#2| |l| |ISTMP#1| |b|)
+    (DECLARE (SPECIAL |$InteractiveMode|))
     (RETURN
-     (PROGN
-      (SETQ |$op| NIL)
-      (SETQ |$GenVarCounter| 0)
-      (|bpRequire| #'|bpComma|)
-      (SETQ |b| (|bpPop1|))
-      (|bpPush|
-       (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
-             ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
-                   (PROGN
-                    (SETQ |ISTMP#1| (CDR |b|))
-                    (AND (CONSP |ISTMP#1|)
-                         (PROGN
-                          (SETQ |l| (CAR |ISTMP#1|))
-                          (SETQ |ISTMP#2| (CDR |ISTMP#1|))
-                          (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
-                               (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
-                   (SYMBOLP |l|))
-              (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
-                    (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
-             (T (|translateToplevel| |b| NIL))))))))
+     (LET* ((|$op| NIL) (|$GenVarCounter| 0))
+       (DECLARE (SPECIAL |$op| |$GenVarCounter|))
+       (PROGN
+        (|bpRequire| #'|bpComma|)
+        (SETQ |b| (|bpPop1|))
+        (|bpPush|
+         (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
+               ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+                     (PROGN
+                      (SETQ |ISTMP#1| (CDR |b|))
+                      (AND (CONSP |ISTMP#1|)
+                           (PROGN
+                            (SETQ |l| (CAR |ISTMP#1|))
+                            (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                            (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                                 (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
+                     (SYMBOLP |l|))
+                (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
+                      (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
+               (T (|translateToplevel| |b| NIL)))))))))
 
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index af316d42..b48125fc 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -53,37 +53,35 @@
                   (T T)))))))
 
 (DEFUN |shoeLineToks| (|s|)
-  (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |dq|
-         |command|)
-    (DECLARE (SPECIAL |$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f|))
+  (PROG (|toks| |dq| |command|)
     (RETURN
-     (PROGN
-      (SETQ |$f| NIL)
-      (SETQ |$r| NIL)
-      (SETQ |$ln| NIL)
-      (SETQ |$n| NIL)
-      (SETQ |$sz| NIL)
-      (SETQ |$floatok| T)
-      (SETQ |$linepos| |s|)
-      (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
-            ((NULL |$n|) (|shoeLineToks| |$r|))
-            ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
-             (COND
-              ((SETQ |command| (|shoeLine?| |$ln|))
-               (SETQ |dq|
-                       (|dqUnit|
-                        (|shoeConstructToken| |$linepos|
-                                              (|shoeLeafLine| |command|) 0)))
-               (CONS (LIST |dq|) |$r|))
-              ((SETQ |command| (|shoeLisp?| |$ln|))
-               (|shoeLispToken| |$r| |command|))
-              (T (|shoeLineToks| |$r|))))
-            (T (SETQ |toks| NIL)
-             (LOOP
-              (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
-                    (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
-             (COND ((NULL |toks|) (|shoeLineToks| |$r|))
-                   (T (CONS (LIST |toks|) |$r|)))))))))
+     (LET* ((|$f| NIL)
+            (|$r| NIL)
+            (|$ln| NIL)
+            (|$n| NIL)
+            (|$sz| NIL)
+            (|$floatok| T)
+            (|$linepos| |s|))
+       (DECLARE (SPECIAL |$f| |$r| |$ln| |$n| |$sz| |$floatok| |$linepos|))
+       (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
+             ((NULL |$n|) (|shoeLineToks| |$r|))
+             ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+              (COND
+               ((SETQ |command| (|shoeLine?| |$ln|))
+                (SETQ |dq|
+                        (|dqUnit|
+                         (|shoeConstructToken| |$linepos|
+                                               (|shoeLeafLine| |command|) 0)))
+                (CONS (LIST |dq|) |$r|))
+               ((SETQ |command| (|shoeLisp?| |$ln|))
+                (|shoeLispToken| |$r| |command|))
+               (T (|shoeLineToks| |$r|))))
+             (T (SETQ |toks| NIL)
+              (LOOP
+               (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
+                     (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
+              (COND ((NULL |toks|) (|shoeLineToks| |$r|))
+                    (T (CONS (LIST |toks|) |$r|)))))))))
 
 (DEFUN |shoeLispToken| (|s| |string|)
   (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 31e89d35..9362b70e 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -122,9 +122,9 @@
     (|endCompileDuration|)))
 
 (DEFUN BOOTCLAM (|fn| |out|)
-  (PROG (|$bfClamming|)
+  (LET ((|$bfClamming| T))
     (DECLARE (SPECIAL |$bfClamming|))
-    (RETURN (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
+    (BOOTCLAMLINES NIL |fn| |out|)))
 
 (DEFUN BOOTCLAMLINES (|lines| |fn| |out|) (BOOTTOCLLINES |lines| |fn| |out|))
 
@@ -252,18 +252,20 @@
         (PROGN (|closeStream| |a|) (|setCurrentPackage| |b|)))))))
 
 (DEFUN BOCLAM (|fn|)
-  (PROG (|$bfClamming| |a| |callingPackage|)
-    (DECLARE (SPECIAL |$bfClamming|))
+  (PROG (|a| |callingPackage|)
     (RETURN
      (PROGN
       (SETQ |callingPackage| *PACKAGE*)
       (IN-PACKAGE "BOOTTRAN")
-      (SETQ |$bfClamming| T)
-      (UNWIND-PROTECT
+      (LET ((|$bfClamming| T))
+        (DECLARE (SPECIAL |$bfClamming|))
+        (UNWIND-PROTECT
+            (PROGN
+             (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+             (|shoeToConsole| |a| |fn|))
           (PROGN
-           (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
-           (|shoeToConsole| |a| |fn|))
-        (PROGN (|closeStream| |a|) (|setCurrentPackage| |callingPackage|)))))))
+           (|closeStream| |a|)
+           (|setCurrentPackage| |callingPackage|))))))))
 
 (DEFUN |shoeToConsole| (|a| |fn|)
   (COND ((NULL |a|) (|shoeNotFound| |fn|))
@@ -805,25 +807,30 @@
 (DEFPARAMETER |$lispWordTable| NIL)
 
 (DEFUN |shoeDfu| (|a| |fn|)
-  (PROG (|$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
-         |$lispWordTable| |stream|)
-    (DECLARE
-     (SPECIAL |$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
-      |$lispWordTable|))
+  (PROG (|stream|)
     (RETURN
      (COND ((NULL |a|) (|shoeNotFound| |fn|))
-           (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
-            (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
-              (SETF (|tableValue| |$lispWordTable| |i|) T))
-            (SETQ |$bootDefined| (|makeTable| #'EQ))
-            (SETQ |$bootUsed| (|makeTable| #'EQ))
-            (SETQ |$bootDefinedTwice| NIL) (SETQ |$bfClamming| NIL)
-            (|shoeDefUse| (|shoeTransformStream| |a|))
-            (UNWIND-PROTECT
-                (PROGN
-                 (SETQ |stream| (|outputTextFile| (CONCAT |fn| ".defuse")))
-                 (|shoeReport| |stream|))
-              (|closeStream| |stream|)))))))
+           (T
+            (LET ((|$lispWordTable| (|makeTable| #'EQ)))
+              (DECLARE (SPECIAL |$lispWordTable|))
+              (PROGN
+               (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
+                 (SETF (|tableValue| |$lispWordTable| |i|) T))
+               (LET* ((|$bootDefined| (|makeTable| #'EQ))
+                      (|$bootUsed| (|makeTable| #'EQ))
+                      (|$bootDefinedTwice| NIL)
+                      (|$bfClamming| NIL))
+                 (DECLARE
+                  (SPECIAL |$bootDefined| |$bootUsed| |$bootDefinedTwice|
+                   |$bfClamming|))
+                 (PROGN
+                  (|shoeDefUse| (|shoeTransformStream| |a|))
+                  (UNWIND-PROTECT
+                      (PROGN
+                       (SETQ |stream|
+                               (|outputTextFile| (CONCAT |fn| ".defuse")))
+                       (|shoeReport| |stream|))
+                    (|closeStream| |stream|)))))))))))
 
 (DEFUN |shoeReport| (|stream|)
   (PROG (|b| |a|)
@@ -1082,25 +1089,28 @@
        (|closeStream| |a|)))))
 
 (DEFUN |shoeXref| (|a| |fn|)
-  (PROG (|$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable| |stream|
-         |out|)
-    (DECLARE
-     (SPECIAL |$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable|))
+  (PROG (|stream| |out|)
     (RETURN
      (COND ((NULL |a|) (|shoeNotFound| |fn|))
-           (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
-            (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
-              (SETF (|tableValue| |$lispWordTable| |i|) T))
-            (SETQ |$bootDefined| (|makeTable| #'EQ))
-            (SETQ |$bootUsed| (|makeTable| #'EQ)) (SETQ |$bfClamming| NIL)
-            (|shoeDefUse| (|shoeTransformStream| |a|))
-            (SETQ |out| (CONCAT |fn| ".xref"))
-            (UNWIND-PROTECT
-                (PROGN
-                 (SETQ |stream| (|outputTextFile| |out|))
-                 (|shoeXReport| |stream|)
-                 |out|)
-              (|closeStream| |stream|)))))))
+           (T
+            (LET ((|$lispWordTable| (|makeTable| #'EQ)))
+              (DECLARE (SPECIAL |$lispWordTable|))
+              (PROGN
+               (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
+                 (SETF (|tableValue| |$lispWordTable| |i|) T))
+               (LET* ((|$bootDefined| (|makeTable| #'EQ))
+                      (|$bootUsed| (|makeTable| #'EQ))
+                      (|$bfClamming| NIL))
+                 (DECLARE (SPECIAL |$bootDefined| |$bootUsed| |$bfClamming|))
+                 (PROGN
+                  (|shoeDefUse| (|shoeTransformStream| |a|))
+                  (SETQ |out| (CONCAT |fn| ".xref"))
+                  (UNWIND-PROTECT
+                      (PROGN
+                       (SETQ |stream| (|outputTextFile| |out|))
+                       (|shoeXReport| |stream|)
+                       |out|)
+                    (|closeStream| |stream|)))))))))))
 
 (DEFUN |shoeXReport| (|stream|)
   (PROG (|a| |c|)
diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot
index 32ece73c..858f5c77 100644
--- a/src/interp/newfort.boot
+++ b/src/interp/newfort.boot
@@ -727,7 +727,7 @@ fortFormatCharacterTypes(names) ==
 
 fortFormatIntrinsics(l) ==
   $fortError : local := nil
-  null l => return nil
+  null l => nil
   displayLines fortran2Lines ['"INTRINSIC ",:addCommas(l)]