aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/ast.boot16
-rw-r--r--src/boot/parser.boot9
-rw-r--r--src/boot/strap/ast.clisp26
-rw-r--r--src/boot/strap/parser.clisp8
-rw-r--r--src/boot/strap/translator.clisp3
-rw-r--r--src/boot/translator.boot1
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