aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-05-18 04:01:53 +0000
committerdos-reis <gdr@axiomatics.org>2011-05-18 04:01:53 +0000
commitfd748db1e503f9d27de5b91ba607c550ccd16991 (patch)
treeca96cf4ede461bf9cf04502c2aa6b062d52fd9c4
parent24d0e78582cacadeb56a0e0efdd41ce5ff3a9354 (diff)
downloadopen-axiom-fd748db1e503f9d27de5b91ba607c550ccd16991.tar.gz
more Boot cleanup
-rw-r--r--src/boot/ast.boot28
-rw-r--r--src/boot/strap/ast.clisp48
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