aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/ast.boot48
-rw-r--r--src/boot/strap/ast.clisp62
3 files changed, 72 insertions, 44 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index bc364249..0c2aee52 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
2012-05-31 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/ast.boot (%LoadUnit): Add fields for let var and is var
+ sequence numbers.
+ Eliminate $letGenVarCounter and $isGenVarCounter.
+
+2012-05-31 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* boot/ast.boot: Add a %LoadUnit parameter to most functions.
Adjust callers.
* boot/translator.boot: Tidy.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index fcb7ffff..94c4c5ff 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -118,16 +118,18 @@ structure %Ast ==
--% Data type for translation units data
--%
structure %LoadUnit ==
- Record(fdefs: %List %Thing, sigs: %List %Thing,
- xports: %List %Identifier, csts: %List %Binding, varno: %Short) with
+ Record(fdefs: %List %Thing,sigs: %List %Thing,xports: %List %Identifier,
+ csts: %List %Binding,varno: %Short,letno: %Short,isno: %Short) with
functionDefinitions == (.fdefs) -- functions defined in this TU
globalSignatures == (.sigs) -- signatures proclaimed by this TU
exportedNames == (.xports) -- names exported by this TU
constantBindings == (.csts) -- constants defined in this TU
currentGensymNumber == (.varno) -- current gensym sequence number
+ letVariableNumer == (.letno) -- let variable sequence number
+ isVariableNumber == (.isno) -- is variable sequence number
makeLoadUnit() ==
- mk%LoadUnit(nil,nil,nil,nil,0)
+ mk%LoadUnit(nil,nil,nil,nil,0,0,0)
pushFunctionDefinition(tu,def) ==
functionDefinitions(tu) := [def,:functionDefinitions tu]
@@ -153,15 +155,15 @@ bfGenSymbol tu ==
currentGensymNumber(tu) := currentGensymNumber tu + 1
makeSymbol strconc('"bfVar#",toString currentGensymNumber tu)
-bfLetVar: () -> %Symbol
-bfLetVar() ==
- $letGenVarCounter := $letGenVarCounter + 1
- makeSymbol strconc('"LETTMP#",toString $letGenVarCounter)
+bfLetVar: %LoadUnit -> %Symbol
+bfLetVar tu ==
+ letVariableNumer(tu) := letVariableNumer tu + 1
+ makeSymbol strconc('"LETTMP#",toString letVariableNumer tu)
-bfIsVar: () -> %Symbol
-bfIsVar() ==
- $isGenVarCounter := $isGenVarCounter + 1
- makeSymbol strconc('"ISTMP#",toString $isGenVarCounter)
+bfIsVar: %LoadUnit -> %Symbol
+bfIsVar tu ==
+ isVariableNumber(tu) := isVariableNumber tu + 1
+ makeSymbol strconc('"ISTMP#",toString isVariableNumber tu)
bfColon: %Thing -> %Form
bfColon x==
@@ -640,7 +642,7 @@ bfLET1(tu,lhs,rhs) ==
l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2]
if symbol? first l2 then l2 := [l2,:nil]
bfMKPROGN [l1,:l2,name]
- g := bfLetVar()
+ g := bfLetVar tu
rhs1 := ['L%T,g,rhs]
let1 := bfLET1(tu,lhs,g)
let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1]
@@ -678,7 +680,7 @@ bfLET2(tu,lhs,rhs) ==
lhs is ['append,var1,var2] =>
patrev := bfISReverse(var2,var1)
rev := ['reverse,rhs]
- g := bfLetVar()
+ g := bfLetVar tu
l2 := bfLET2(tu,patrev,g)
if cons? l2 and first l2 isnt [.,:.] then
l2 := [l2,:nil]
@@ -702,8 +704,11 @@ bfLET2(tu,lhs,rhs) ==
bfLET(tu,lhs,rhs) ==
- $letGenVarCounter : local := 0
- bfLET1(tu,lhs,rhs)
+ letno := letVariableNumer tu
+ try
+ letVariableNumer(tu) := 0
+ bfLET1(tu,lhs,rhs)
+ finally letVariableNumer(tu) := letno
addCARorCDR(acc,expr) ==
expr isnt [.,:.] => [acc,expr]
@@ -734,9 +739,12 @@ bfISApplication(tu,op,left,right)==
[op ,left,right]
bfIS(tu,left,right)==
- $isGenVarCounter: local := 0
- $inDefIS: local :=true
- bfIS1(tu,left,right)
+ isno := isVariableNumber tu
+ try
+ isVariableNumber(tu) := 0
+ $inDefIS: local :=true
+ bfIS1(tu,left,right)
+ finally isVariableNumber(tu) := isno
bfISReverse(x,a) ==
x is ['CONS,:.] =>
@@ -764,7 +772,7 @@ bfIS1(tu,lhs,rhs) ==
rhs is ["EQUAL",a] => bfQ(lhs,a)
rhs is ['CONS,a,b] and a is "DOT" and b is "DOT" => ['CONSP,lhs]
cons? lhs =>
- g := bfIsVar()
+ g := bfIsVar tu
bfMKPROGN [['L%T,g,lhs],bfIS1(tu,g,rhs)]
rhs.op is 'CONS =>
[.,a,b] := rhs
@@ -783,7 +791,7 @@ bfIS1(tu,lhs,rhs) ==
rhs.op is 'append =>
[.,a,b] := rhs
patrev := bfISReverse(b,a)
- g := bfIsVar()
+ g := bfIsVar tu
rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['reverse,lhs]],'T]]
l2 := bfIS1(tu,g,patrev)
if cons? l2 and first l2 isnt [.,:.] then
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index b8ae1806..b3abb36f 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -149,11 +149,13 @@
|sigs|
|xports|
|csts|
- |varno|)
+ |varno|
+ |letno|
+ |isno|)
-(DEFMACRO |mk%LoadUnit| (|fdefs| |sigs| |xports| |csts| |varno|)
+(DEFMACRO |mk%LoadUnit| (|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno|)
(LIST '|MAKE-%LoadUnit| :|fdefs| |fdefs| :|sigs| |sigs| :|xports| |xports|
- :|csts| |csts| :|varno| |varno|))
+ :|csts| |csts| :|varno| |varno| :|letno| |letno| :|isno| |isno|))
(DEFMACRO |functionDefinitions| (|bfVar#1|) (LIST '|%LoadUnit-fdefs| |bfVar#1|))
@@ -165,7 +167,11 @@
(DEFMACRO |currentGensymNumber| (|bfVar#1|) (LIST '|%LoadUnit-varno| |bfVar#1|))
-(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0))
+(DEFMACRO |letVariableNumer| (|bfVar#1|) (LIST '|%LoadUnit-letno| |bfVar#1|))
+
+(DEFMACRO |isVariableNumber| (|bfVar#1|) (LIST '|%LoadUnit-isno| |bfVar#1|))
+
+(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0))
(DEFUN |pushFunctionDefinition| (|tu| |def|)
(SETF (|functionDefinitions| |tu|) (CONS |def| (|functionDefinitions| |tu|))))
@@ -185,21 +191,19 @@
(SETF (|currentGensymNumber| |tu|) (+ (|currentGensymNumber| |tu|) 1))
(INTERN (CONCAT "bfVar#" (WRITE-TO-STRING (|currentGensymNumber| |tu|))))))
-(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfLetVar|))
+(DECLAIM (FTYPE (FUNCTION (|%LoadUnit|) |%Symbol|) |bfLetVar|))
-(DEFUN |bfLetVar| ()
- (DECLARE (SPECIAL |$letGenVarCounter|))
+(DEFUN |bfLetVar| (|tu|)
(PROGN
- (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
- (INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING |$letGenVarCounter|)))))
+ (SETF (|letVariableNumer| |tu|) (+ (|letVariableNumer| |tu|) 1))
+ (INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING (|letVariableNumer| |tu|))))))
-(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfIsVar|))
+(DECLAIM (FTYPE (FUNCTION (|%LoadUnit|) |%Symbol|) |bfIsVar|))
-(DEFUN |bfIsVar| ()
- (DECLARE (SPECIAL |$isGenVarCounter|))
+(DEFUN |bfIsVar| (|tu|)
(PROGN
- (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
- (INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING |$isGenVarCounter|)))))
+ (SETF (|isVariableNumber| |tu|) (+ (|isVariableNumber| |tu|) 1))
+ (INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING (|isVariableNumber| |tu|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfColon|))
@@ -896,7 +900,7 @@
(|bfMKPROGN| (CONS |l1| (CDR |l2|))))
(T (COND ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
(|bfMKPROGN| (CONS |l1| (|append| |l2| (CONS |name| NIL)))))))
- (T (SETQ |g| (|bfLetVar|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
+ (T (SETQ |g| (|bfLetVar| |tu|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
(SETQ |let1| (|bfLET1| |tu| |lhs| |g|))
(COND
((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN))
@@ -987,7 +991,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| (|bfLetVar|))
+ (SETQ |rev| (LIST '|reverse| |rhs|)) (SETQ |g| (|bfLetVar| |tu|))
(SETQ |l2| (|bfLET2| |tu| |patrev| |g|))
(COND
((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|))))
@@ -1031,9 +1035,12 @@
(LIST 'COND (LIST |isPred| |rhs|))))))
(DEFUN |bfLET| (|tu| |lhs| |rhs|)
- (LET ((|$letGenVarCounter| 0))
- (DECLARE (SPECIAL |$letGenVarCounter|))
- (|bfLET1| |tu| |lhs| |rhs|)))
+ (LET* (|letno|)
+ (PROGN
+ (SETQ |letno| (|letVariableNumer| |tu|))
+ (UNWIND-PROTECT
+ (PROGN (SETF (|letVariableNumer| |tu|) 0) (|bfLET1| |tu| |lhs| |rhs|))
+ (SETF (|letVariableNumer| |tu|) |letno|)))))
(DEFUN |addCARorCDR| (|acc| |expr|)
(LET* (|funsR| |funsA| |p| |funs|)
@@ -1068,9 +1075,16 @@
(T (LIST |op| |left| |right|))))
(DEFUN |bfIS| (|tu| |left| |right|)
- (LET* ((|$isGenVarCounter| 0) (|$inDefIS| T))
- (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|))
- (|bfIS1| |tu| |left| |right|)))
+ (LET* (|isno|)
+ (PROGN
+ (SETQ |isno| (|isVariableNumber| |tu|))
+ (UNWIND-PROTECT
+ (PROGN
+ (SETF (|isVariableNumber| |tu|) 0)
+ (LET ((|$inDefIS| T))
+ (DECLARE (SPECIAL |$inDefIS|))
+ (|bfIS1| |tu| |left| |right|)))
+ (SETF (|isVariableNumber| |tu|) |isno|)))))
(DEFUN |bfISReverse| (|x| |a|)
(LET* (|y|)
@@ -1129,7 +1143,7 @@
(PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))
(EQ |a| 'DOT) (EQ |b| 'DOT))
(LIST 'CONSP |lhs|))
- ((CONSP |lhs|) (SETQ |g| (|bfIsVar|))
+ ((CONSP |lhs|) (SETQ |g| (|bfIsVar| |tu|))
(|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |tu| |g| |rhs|))))
((EQ (CAR |rhs|) 'CONS) (SETQ |a| (CADR . #2=(|rhs|)))
(SETQ |b| (CADDR . #2#))
@@ -1170,7 +1184,7 @@
(T (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|)))))))
((EQ (CAR |rhs|) '|append|) (SETQ |a| (CADR . #3=(|rhs|)))
(SETQ |b| (CADDR . #3#)) (SETQ |patrev| (|bfISReverse| |b| |a|))
- (SETQ |g| (|bfIsVar|))
+ (SETQ |g| (|bfIsVar| |tu|))
(SETQ |rev|
(|bfAND|
(LIST (LIST 'CONSP |lhs|)