more cleanup

2 files changed, 52 insertions, 56 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index e59d290d..f6819e08 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -965,43 +965,43 @@ isDynamicVariable x ==
  
 shoeCompTran1 x ==
   atom x =>
-    isDynamicVariable x =>
-      $dollarVars:=
-	 symbolMember?(x,$dollarVars)=>$dollarVars
-	 [x,:$dollarVars]
-    nil
+    if isDynamicVariable x and not symbolMember?(x,$dollarVars) then
+      $dollarVars := [x,:$dollarVars]
+    x
   U := first x
-  U is "QUOTE" => nil
+  U is "QUOTE" => x
   x is ["L%T",l,r] =>
     x.op := "SETQ"
-    shoeCompTran1 r
+    third(x) := shoeCompTran1 r
     symbol? l =>
-      not bfBeginsDollar l=>
-	$locVars:=
-	   symbolMember?(l,$locVars)=>$locVars
-	   [l,:$locVars]
-      $dollarVars:=
-	 symbolMember?(l,$dollarVars)=>$dollarVars
-	 [l,:$dollarVars]
+      bfBeginsDollar l =>
+        if not symbolMember?(l,$dollarVars) then
+          $dollarVars := [l,:$dollarVars]
+        x
+      if not symbolMember?(l,$locVars) then
+        $locVars := [l,:$locVars]
+      x
     l is ["FLUID",:.] =>
-      $fluidVars:=
-	 symbolMember?(second l,$fluidVars)=>$fluidVars
-	 [second l,:$fluidVars]
+      if not symbolMember?(second l,$fluidVars) then
+        $fluidVars := [second l,:$fluidVars]
       x.rest.first := second l
-  U is "%Leave" => x.op := "RETURN"
+      x
+  U is "%Leave" => (x.op := "RETURN"; x)
   U in '(PROG LAMBDA) =>
     newbindings := nil
     for y in second x repeat
       not symbolMember?(y,$locVars)=>
 	$locVars := [y,:$locVars]
 	newbindings := [y,:newbindings]
-    res := shoeCompTran1 CDDR x
+    rest(x).rest := shoeCompTran1 CDDR x
     $locVars := [y for y in $locVars | not symbolMember?(y,newbindings)]
+    x
   -- literal vectors.
-  x is ['vector,['LIST,:args]] => (x.op := 'VECTOR; x.args := args)
-  x is ['vector,'NIL] => (x.op := 'VECTOR; x.args := nil)
-  shoeCompTran1 first x
-  shoeCompTran1 rest x
+  x is ['vector,['LIST,:args]] => (x.op := 'VECTOR; x.args := args; x)
+  x is ['vector,'NIL] => (x.op := 'VECTOR; x.args := nil; x)
+  x.first := shoeCompTran1 first x
+  x.rest := shoeCompTran1 rest x
+  x
  
 bfTagged(a,b)==
   $op = nil => %Signature(a,b)        -- surely a toplevel decl
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 6aeeec23..4d3fb2a8 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1827,21 +1827,19 @@
         (T NIL)))))
 
 (DEFUN |shoeCompTran1| (|x|)
-  (PROG (|args| |res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U)
+  (PROG (|args| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U)
     (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|))
     (RETURN
       (COND
         ((ATOM |x|)
          (COND
-           ((|isDynamicVariable| |x|)
-            (SETQ |$dollarVars|
-                  (COND
-                    ((|symbolMember?| |x| |$dollarVars|) |$dollarVars|)
-                    (T (CONS |x| |$dollarVars|)))))
-           (T NIL)))
+           ((AND (|isDynamicVariable| |x|)
+                 (NOT (|symbolMember?| |x| |$dollarVars|)))
+            (SETQ |$dollarVars| (CONS |x| |$dollarVars|))))
+         |x|)
         (T (SETQ U (CAR |x|))
            (COND
-             ((EQ U 'QUOTE) NIL)
+             ((EQ U 'QUOTE) |x|)
              ((AND (CONSP |x|) (EQ (CAR |x|) 'L%T)
                    (PROGN
                      (SETQ |ISTMP#1| (CDR |x|))
@@ -1852,29 +1850,26 @@
                             (AND (CONSP |ISTMP#2|)
                                  (NULL (CDR |ISTMP#2|))
                                  (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
-              (RPLACA |x| 'SETQ) (|shoeCompTran1| |r|)
+              (RPLACA |x| 'SETQ)
+              (SETF (CADDR |x|) (|shoeCompTran1| |r|))
               (COND
                 ((SYMBOLP |l|)
                  (COND
-                   ((NOT (|bfBeginsDollar| |l|))
-                    (SETQ |$locVars|
-                          (COND
-                            ((|symbolMember?| |l| |$locVars|)
-                             |$locVars|)
-                            (T (CONS |l| |$locVars|)))))
-                   (T (SETQ |$dollarVars|
-                            (COND
-                              ((|symbolMember?| |l| |$dollarVars|)
-                               |$dollarVars|)
-                              (T (CONS |l| |$dollarVars|)))))))
+                   ((|bfBeginsDollar| |l|)
+                    (COND
+                      ((NOT (|symbolMember?| |l| |$dollarVars|))
+                       (SETQ |$dollarVars| (CONS |l| |$dollarVars|))))
+                    |x|)
+                   (T (COND
+                        ((NOT (|symbolMember?| |l| |$locVars|))
+                         (SETQ |$locVars| (CONS |l| |$locVars|))))
+                      |x|)))
                 ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID))
-                 (SETQ |$fluidVars|
-                       (COND
-                         ((|symbolMember?| (CADR |l|) |$fluidVars|)
-                          |$fluidVars|)
-                         (T (CONS (CADR |l|) |$fluidVars|))))
-                 (RPLACA (CDR |x|) (CADR |l|)))))
-             ((EQ U '|%Leave|) (RPLACA |x| 'RETURN))
+                 (COND
+                   ((NOT (|symbolMember?| (CADR |l|) |$fluidVars|))
+                    (SETQ |$fluidVars| (CONS (CADR |l|) |$fluidVars|))))
+                 (RPLACA (CDR |x|) (CADR |l|)) |x|)))
+             ((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|)
              ((|symbolMember?| U '(PROG LAMBDA))
               (SETQ |newbindings| NIL)
               (LET ((|bfVar#136| (CADR |x|)) (|y| NIL))
@@ -1890,7 +1885,7 @@
                            (SETQ |newbindings|
                                  (CONS |y| |newbindings|))))))
                   (SETQ |bfVar#136| (CDR |bfVar#136|))))
-              (SETQ |res| (|shoeCompTran1| (CDDR |x|)))
+              (RPLACD (CDR |x|) (|shoeCompTran1| (CDDR |x|)))
               (SETQ |$locVars|
                     (LET ((|bfVar#138| NIL) (|bfVar#139| NIL)
                           (|bfVar#137| |$locVars|) (|y| NIL))
@@ -1911,7 +1906,8 @@
                                     (T (RPLACD |bfVar#139| #0#)
                                      (SETQ |bfVar#139|
                                       (CDR |bfVar#139|)))))))
-                        (SETQ |bfVar#137| (CDR |bfVar#137|))))))
+                        (SETQ |bfVar#137| (CDR |bfVar#137|)))))
+              |x|)
              ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|)
                    (PROGN
                      (SETQ |ISTMP#1| (CDR |x|))
@@ -1923,15 +1919,15 @@
                                  (PROGN
                                    (SETQ |args| (CDR |ISTMP#2|))
                                    T))))))
-              (RPLACA |x| 'VECTOR) (RPLACD |x| |args|))
+              (RPLACA |x| 'VECTOR) (RPLACD |x| |args|) |x|)
              ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|)
                    (PROGN
                      (SETQ |ISTMP#1| (CDR |x|))
                      (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
                           (EQ (CAR |ISTMP#1|) 'NIL))))
-              (RPLACA |x| 'VECTOR) (RPLACD |x| NIL))
-             (T (|shoeCompTran1| (CAR |x|))
-                (|shoeCompTran1| (CDR |x|)))))))))
+              (RPLACA |x| 'VECTOR) (RPLACD |x| NIL) |x|)
+             (T (RPLACA |x| (|shoeCompTran1| (CAR |x|)))
+                (RPLACD |x| (|shoeCompTran1| (CDR |x|))) |x|)))))))
 
 (DEFUN |bfTagged| (|a| |b|)
   (DECLARE (SPECIAL |$typings| |$op|))