From fd748db1e503f9d27de5b91ba607c550ccd16991 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 18 May 2011 04:01:53 +0000
Subject: more Boot cleanup

---
 src/boot/ast.boot        | 28 +++++++++++++++++-----------
 src/boot/strap/ast.clisp | 48 +++++++++++++++++++++++-------------------------
 2 files changed, 40 insertions(+), 36 deletions(-)

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 61fc648a..75e582e6 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -125,6 +125,16 @@ bfGenSymbol()==
   $GenVarCounter := $GenVarCounter+1
   makeSymbol strconc('"bfVar#",toString $GenVarCounter)
 
+bfLetVar: () -> %Symbol
+bfLetVar() ==
+  $letGenVarCounter := $letGenVarCounter + 1
+  makeSymbol strconc('"LETTMP#",toString $letGenVarCounter)
+
+bfIsVar: () -> %Symbol
+bfIsVar() ==
+  $isGenVarCounter := $isGenVarCounter + 1
+  makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
+
 bfColon: %Thing -> %Form
 bfColon x== 
   ["COLON",x]
@@ -545,8 +555,7 @@ bfLET1(lhs,rhs) ==
     l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2]
     if symbol? first l2 then l2 := [l2,:nil]
     bfMKPROGN [l1,:l2,name]
-  g := makeSymbol strconc('"LETTMP#",toString $letGenVarCounter)
-  $letGenVarCounter := $letGenVarCounter + 1
+  g := bfLetVar()
   rhs1 := ['L%T,g,rhs]
   let1 := bfLET1(lhs,g)
   let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1]
@@ -582,8 +591,7 @@ bfLET2(lhs,rhs) ==
   lhs is ['append,var1,var2] =>
     patrev := bfISReverse(var2,var1)
     rev := ['reverse,rhs]
-    g := makeSymbol strconc('"LETTMP#", toString $letGenVarCounter)
-    $letGenVarCounter := $letGenVarCounter + 1
+    g := bfLetVar()
     l2 := bfLET2(patrev,g)
     if cons? l2 and atom first l2 then
       l2 := [l2,:nil]
@@ -607,7 +615,7 @@ bfLET2(lhs,rhs) ==
  
  
 bfLET(lhs,rhs) ==
-  $letGenVarCounter : local := 1
+  $letGenVarCounter : local := 0
   bfLET1(lhs,rhs)
  
 addCARorCDR(acc,expr) ==
@@ -639,8 +647,8 @@ bfISApplication(op,left,right)==
   [op ,left,right]
  
 bfIS(left,right)==
-  $isGenVarCounter: local :=1
-  $inDefIS:local :=true
+  $isGenVarCounter: local := 0
+  $inDefIS: local :=true
   bfIS1(left,right)
  
 bfISReverse(x,a) ==
@@ -666,8 +674,7 @@ bfIS1(lhs,rhs) ==
     bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]]
   rhs is ["EQUAL",a] => bfQ(lhs,a)
   cons? lhs =>
-    g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
+    g := bfIsVar()
     bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)]
   rhs is ['CONS,a,b] =>
     a is "DOT" =>
@@ -683,8 +690,7 @@ bfIS1(lhs,rhs) ==
     bfAND [['CONSP,lhs],a1,b1]
   rhs is ['append,a,b] =>
     patrev := bfISReverse(b,a)
-    g := makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
-    $isGenVarCounter := $isGenVarCounter + 1
+    g := bfIsVar()
     rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['reverse,lhs]],'T]]
     l2 := bfIS1(g,patrev)
     if cons? l2 and atom first l2 then l2 := [l2,:nil]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index d0e75830..beae254d 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -157,6 +157,22 @@
     (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1))
     (INTERN (CONCAT "bfVar#" (WRITE-TO-STRING |$GenVarCounter|)))))
 
+(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfLetVar|))
+
+(DEFUN |bfLetVar| ()
+  (DECLARE (SPECIAL |$letGenVarCounter|))
+  (PROGN
+    (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
+    (INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING |$letGenVarCounter|)))))
+
+(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfIsVar|))
+
+(DEFUN |bfIsVar| ()
+  (DECLARE (SPECIAL |$isGenVarCounter|))
+  (PROGN
+    (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
+    (INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING |$isGenVarCounter|)))))
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfColon|))
 
 (DEFUN |bfColon| (|x|) (LIST 'COLON |x|))
@@ -787,7 +803,6 @@
 
 (DEFUN |bfLET1| (|lhs| |rhs|)
   (PROG (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|)
-    (DECLARE (SPECIAL |$letGenVarCounter|))
     (RETURN
       (COND
         ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
@@ -818,11 +833,7 @@
                 ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
               (|bfMKPROGN|
                   (CONS |l1| (|append| |l2| (CONS |name| NIL)))))))
-        (T (SETQ |g|
-                 (INTERN (CONCAT "LETTMP#"
-                                 (WRITE-TO-STRING |$letGenVarCounter|))))
-           (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
-           (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
+        (T (SETQ |g| (|bfLetVar|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
            (SETQ |let1| (|bfLET1| |lhs| |g|))
            (COND
              ((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN))
@@ -842,7 +853,7 @@
 (DEFUN |bfLET2| (|lhs| |rhs|)
   (PROG (|isPred| |val1| |ISTMP#3| |g| |rev| |patrev| |l2| |l1| |var2|
             |var1| |b| |ISTMP#2| |a| |ISTMP#1|)
-    (DECLARE (SPECIAL |$inDefIS| |$letGenVarCounter|))
+    (DECLARE (SPECIAL |$inDefIS|))
     (RETURN
       (COND
         ((NULL |lhs|) NIL)
@@ -909,11 +920,7 @@
                        (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                             (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T))))))
          (SETQ |patrev| (|bfISReverse| |var2| |var1|))
-         (SETQ |rev| (LIST '|reverse| |rhs|))
-         (SETQ |g|
-               (INTERN (CONCAT "LETTMP#"
-                               (WRITE-TO-STRING |$letGenVarCounter|))))
-         (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
+         (SETQ |rev| (LIST '|reverse| |rhs|)) (SETQ |g| (|bfLetVar|))
          (SETQ |l2| (|bfLET2| |patrev| |g|))
          (COND
            ((AND (CONSP |l2|) (ATOM (CAR |l2|)))
@@ -960,7 +967,7 @@
   (PROG (|$letGenVarCounter|)
     (DECLARE (SPECIAL |$letGenVarCounter|))
     (RETURN
-      (PROGN (SETQ |$letGenVarCounter| 1) (|bfLET1| |lhs| |rhs|)))))
+      (PROGN (SETQ |$letGenVarCounter| 0) (|bfLET1| |lhs| |rhs|)))))
 
 (DEFUN |addCARorCDR| (|acc| |expr|)
   (PROG (|funsR| |funsA| |p| |funs|)
@@ -1006,7 +1013,7 @@
     (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|))
     (RETURN
       (PROGN
-        (SETQ |$isGenVarCounter| 1)
+        (SETQ |$isGenVarCounter| 0)
         (SETQ |$inDefIS| T)
         (|bfIS1| |left| |right|)))))
 
@@ -1024,7 +1031,6 @@
 (DEFUN |bfIS1| (|lhs| |rhs|)
   (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |b| |g| |l| |d| |ISTMP#2|
               |c| |a| |ISTMP#1|)
-    (DECLARE (SPECIAL |$isGenVarCounter|))
     (RETURN
       (COND
         ((NULL |rhs|) (LIST 'NULL |lhs|))
@@ -1063,11 +1069,7 @@
                 (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
                      (PROGN (SETQ |a| (CAR |ISTMP#1|)) T))))
          (|bfQ| |lhs| |a|))
-        ((CONSP |lhs|)
-         (SETQ |g|
-               (INTERN (CONCAT "ISTMP#"
-                               (WRITE-TO-STRING |$isGenVarCounter|))))
-         (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
+        ((CONSP |lhs|) (SETQ |g| (|bfIsVar|))
          (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|))))
         ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'CONS)
               (PROGN
@@ -1120,11 +1122,7 @@
                        (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                        (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                             (PROGN (SETQ |b| (CAR |ISTMP#2|)) T))))))
-         (SETQ |patrev| (|bfISReverse| |b| |a|))
-         (SETQ |g|
-               (INTERN (CONCAT "ISTMP#"
-                               (WRITE-TO-STRING |$isGenVarCounter|))))
-         (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
+         (SETQ |patrev| (|bfISReverse| |b| |a|)) (SETQ |g| (|bfIsVar|))
          (SETQ |rev|
                (|bfAND| (LIST (LIST 'CONSP |lhs|)
                               (LIST 'PROGN
-- 
cgit v1.2.3