diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/boot/ast.boot | 16 | ||||
| -rw-r--r-- | src/boot/parser.boot | 9 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 26 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 8 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 3 | ||||
| -rw-r--r-- | src/boot/translator.boot | 1 |
7 files changed, 40 insertions, 28 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 0c2aee52..1587853c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-06-01 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/ast.boot (%LoadUnit): Add fields for side conditions. + * boot/parser.boot: Adjust. + 2012-05-31 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/ast.boot (%LoadUnit): Add fields for let var and is var diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 94c4c5ff..91a3d030 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -118,8 +118,9 @@ 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,letno: %Short,isno: %Short) with + Record(fdefs: %List %Thing,sigs: %List %Thing,xports: %List %Identifier,_ + csts: %List %Binding,varno: %Short,letno: %Short,isno: %Short,_ + sconds: %List %Thing) with functionDefinitions == (.fdefs) -- functions defined in this TU globalSignatures == (.sigs) -- signatures proclaimed by this TU exportedNames == (.xports) -- names exported by this TU @@ -127,9 +128,10 @@ structure %LoadUnit == currentGensymNumber == (.varno) -- current gensym sequence number letVariableNumer == (.letno) -- let variable sequence number isVariableNumber == (.isno) -- is variable sequence number + sideConditions == (.sconds) -- list of side declarations makeLoadUnit() == - mk%LoadUnit(nil,nil,nil,nil,0,0,0) + mk%LoadUnit(nil,nil,nil,nil,0,0,0,nil) pushFunctionDefinition(tu,def) == functionDefinitions(tu) := [def,:functionDefinitions tu] @@ -947,7 +949,7 @@ bfMDef(tu,op,args,body) == [args] lamex := ["MLAMBDA",argl,backquote(body,argl)] def := [op,lamex] - [shoeComp def,:[:shoeComps bfDef1(tu,d) for d in $wheredefs]] + [shoeComp def,:[:shoeComps bfDef1(tu,d) for d in sideConditions tu]] bfGargl(tu,argl) == argl = nil => [[],[],[],[]] @@ -978,7 +980,7 @@ bfDef(tu,op,args,body) == [.,op1,arg1,:body1] := shoeComp first bfDef1(tu,[op,args,body]) bfCompHash(tu,op1,arg1,body1) bfTuple - [:shoeComps bfDef1(tu,d) for d in [[op,args,body],:$wheredefs]] + [:shoeComps bfDef1(tu,d) for d in [[op,args,body],:sideConditions tu]] shoeComps x== [shoeComp def for def in x] @@ -1260,11 +1262,11 @@ bfSequence l == aft = nil => ["COND",:transform] ["COND",:transform,bfAlternative('T,bfSequence aft)] -bfWhere (context,expr)== +bfWhere(tu,context,expr)== [opassoc,defs,nondefs] := defSheepAndGoats context a:=[[first d,second d,bfSUBLIS(opassoc,third d)] for d in defs] - $wheredefs := [:a,:$wheredefs] + sideConditions(tu) := [:a,:sideConditions tu] bfMKPROGN bfSUBLIS(opassoc,append!(nondefs,[expr])) --shoeReadLispString(s,n)== diff --git a/src/boot/parser.boot b/src/boot/parser.boot index f1c8c8c2..d612a89e 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -988,7 +988,7 @@ bpDefinition ps == bpStoreName ps == $op := first parserTrees ps - $wheredefs := nil + sideConditions(parserLoadUnit ps) := nil $typings := nil true @@ -1020,9 +1020,10 @@ bpDefTail(ps,f) == or bpCompoundDefinitionTail(ps,f) bpWhere ps == - bpDefinition ps and - (bpEqKey(ps,"WHERE") and bpRequire(ps,function bpDefinitionItem) - and bpPush(ps,bfWhere(bpPop1 ps,bpPop1 ps)) or true) + bpDefinition ps and + (bpEqKey(ps,"WHERE") and bpRequire(ps,function bpDefinitionItem) + and bpPush(ps,bfWhere(parserLoadUnit ps,bpPop1 ps,bpPop1 ps)) + or true) bpDefinitionItem ps == a := bpState ps diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index b3abb36f..ae24d89c 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -151,11 +151,14 @@ |csts| |varno| |letno| - |isno|) + |isno| + |sconds|) -(DEFMACRO |mk%LoadUnit| (|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno|) +(DEFMACRO |mk%LoadUnit| + (|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno| |sconds|) (LIST '|MAKE-%LoadUnit| :|fdefs| |fdefs| :|sigs| |sigs| :|xports| |xports| - :|csts| |csts| :|varno| |varno| :|letno| |letno| :|isno| |isno|)) + :|csts| |csts| :|varno| |varno| :|letno| |letno| :|isno| |isno| + :|sconds| |sconds|)) (DEFMACRO |functionDefinitions| (|bfVar#1|) (LIST '|%LoadUnit-fdefs| |bfVar#1|)) @@ -171,7 +174,9 @@ (DEFMACRO |isVariableNumber| (|bfVar#1|) (LIST '|%LoadUnit-isno| |bfVar#1|)) -(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0)) +(DEFMACRO |sideConditions| (|bfVar#1|) (LIST '|%LoadUnit-sconds| |bfVar#1|)) + +(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0 NIL)) (DEFUN |pushFunctionDefinition| (|tu| |def|) (SETF (|functionDefinitions| |tu|) (CONS |def| (|functionDefinitions| |tu|)))) @@ -1516,7 +1521,6 @@ (DEFUN |bfMDef| (|tu| |op| |args| |body|) (LET* (|def| |lamex| |argl|) - (DECLARE (SPECIAL |$wheredefs|)) (PROGN (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) (SETQ |lamex| (LIST 'MLAMBDA |argl| (|backquote| |body| |argl|))) @@ -1524,7 +1528,7 @@ (CONS (|shoeComp| |def|) (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) - (|bfVar#1| |$wheredefs|) + (|bfVar#1| (|sideConditions| |tu|)) (|d| NIL)) (LOOP (COND @@ -1583,7 +1587,7 @@ (DEFUN |bfDef| (|tu| |op| |args| |body|) (LET* (|body1| |arg1| |op1| |LETTMP#1|) - (DECLARE (SPECIAL |$wheredefs| |$bfClamming|)) + (DECLARE (SPECIAL |$bfClamming|)) (COND (|$bfClamming| (SETQ |LETTMP#1| @@ -1594,7 +1598,8 @@ (|bfTuple| (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) - (|bfVar#1| (CONS (LIST |op| |args| |body|) |$wheredefs|)) + (|bfVar#1| + (CONS (LIST |op| |args| |body|) (|sideConditions| |tu|))) (|d| NIL)) (LOOP (COND @@ -2265,9 +2270,8 @@ (CONS (|bfAlternative| 'T (|bfSequence| |aft|)) NIL))))))))) -(DEFUN |bfWhere| (|context| |expr|) +(DEFUN |bfWhere| (|tu| |context| |expr|) (LET* (|a| |nondefs| |defs| |opassoc| |LETTMP#1|) - (DECLARE (SPECIAL |$wheredefs|)) (PROGN (SETQ |LETTMP#1| (|defSheepAndGoats| |context|)) (SETQ |opassoc| (CAR |LETTMP#1|)) @@ -2289,7 +2293,7 @@ (SETQ |bfVar#3| |bfVar#2|)) (T (RPLACD |bfVar#3| #2#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |$wheredefs| (|append| |a| |$wheredefs|)) + (SETF (|sideConditions| |tu|) (|append| |a| (|sideConditions| |tu|))) (|bfMKPROGN| (|bfSUBLIS| |opassoc| (|append!| |nondefs| (LIST |expr|))))))) (DEFUN |bfCompHash| (|tu| |op| |argl| |body|) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index cf602e8a..01a10a34 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -1033,10 +1033,10 @@ (T (|bpRestore| |ps| |a|) NIL)))))) (DEFUN |bpStoreName| (|ps|) - (DECLARE (SPECIAL |$typings| |$wheredefs| |$op|)) + (DECLARE (SPECIAL |$typings| |$op|)) (PROGN (SETQ |$op| (CAR (|parserTrees| |ps|))) - (SETQ |$wheredefs| NIL) + (SETF (|sideConditions| (|parserLoadUnit| |ps|)) NIL) (SETQ |$typings| NIL) T)) @@ -1066,7 +1066,9 @@ (AND (|bpDefinition| |ps|) (OR (AND (|bpEqKey| |ps| 'WHERE) (|bpRequire| |ps| #'|bpDefinitionItem|) - (|bpPush| |ps| (|bfWhere| (|bpPop1| |ps|) (|bpPop1| |ps|)))) + (|bpPush| |ps| + (|bfWhere| (|parserLoadUnit| |ps|) (|bpPop1| |ps|) + (|bpPop1| |ps|)))) T))) (DEFUN |bpDefinitionItem| (|ps|) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 675bd292..afe93b70 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -433,11 +433,10 @@ (DEFUN |shoeOutParse| (|toks|) (LET* (|found| |ps|) - (DECLARE (SPECIAL |$returns| |$typings| |$wheredefs| |$op|)) + (DECLARE (SPECIAL |$returns| |$typings| |$op|)) (PROGN (SETQ |ps| (|makeParserState| |toks|)) (SETQ |$op| NIL) - (SETQ |$wheredefs| NIL) (SETQ |$typings| NIL) (SETQ |$returns| NIL) (|bpFirstTok| |ps|) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 82da1f34..97d96616 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -357,7 +357,6 @@ shoeAddComment l== shoeOutParse toks == ps := makeParserState toks $op :=nil - $wheredefs := [] $typings := [] $returns := [] bpFirstTok ps |