diff options
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/boot/ast.boot | 48 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 62 |
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|) |