aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog13
-rw-r--r--src/algebra/triset.spad.pamphlet8
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/compiler.boot18
-rw-r--r--src/interp/g-util.boot3
5 files changed, 32 insertions, 12 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 6efb85c1..df375ae9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,16 @@
2011-12-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/compiler.boot (setqMultiple): Handle lhs and rhs of type
+ Cross instance.
+ * interp/g-util.boot ($DomainNames): Include Cross.
+ * interp/cattable.boot (genCategoryTable): Do not eval Cross.
+ It is bogus to prepopulate the table with builtin functors anyway.
+ * algebra/triset.spad.pamphlet
+ (PolynomialSetUtilitiesPackage)[removeRedundantFactors]: Do not
+ define `c' and `d' in conditional. Make the initializer conditional.
+
+2011-12-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/nruncomp.boot (washFunctorBody) [clean]: Clean %when
forms too.
@@ -14,7 +25,7 @@
* interp/g-opt.boot (groupVariableDefinitions): Simplify a bit.
(optimizeFunctionDef): Likewise. Change %LET to %store before
- simplification.
+ simplification.
(simplifyVMForm): Do not call changeVariableDefinitionToStore.
2011-12-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/algebra/triset.spad.pamphlet b/src/algebra/triset.spad.pamphlet
index 50b56350..78312236 100644
--- a/src/algebra/triset.spad.pamphlet
+++ b/src/algebra/triset.spad.pamphlet
@@ -1365,11 +1365,9 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
while not empty? toSee repeat
b := first toSee
toSee := rest toSee
- if not infRittWu?(b,a)
- then
- (c,d) := (a,b)
- else
- (c,d) := (b,a)
+ (c,d) :=
+ not infRittWu?(b,a) => (a,b)
+ (b,a)
rrf := unprotectedRemoveRedundantFactors(c,d)
empty? rrf => error"in removeRedundantFactors : (LP,P) -> LP from PSETPK"
c := first rrf
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 4cd1d444..c56c9c17 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -66,7 +66,7 @@ genCategoryTable() ==
-- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT
specialDs := setDifference($nonLisplibDomains,$noCategoryDomains)
domainTable:= [:[addDomainToTable(id, getConstrCat eval([id]).3)
- for id in specialDs], :domainTable]
+ for id in specialDs | id ~= 'Cross], :domainTable]
for [id,:entry] in domainTable repeat
for [a,:b] in encodeCategoryAlist(id,entry) repeat
tableValue(_*HASCATEGORY_-HASH_*,[id,:a]) := b
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index d1a58bd3..140d2362 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -974,12 +974,22 @@ setqMultiple(nameList,val,m,e) ==
T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil
e:= put(g,"mode",m1,e)
[x,m',e]:= coerce(T,m) or return nil
- -- 1.1. exit if result is a list
+ -- 2. exit if result is a list
m1 is ["List",D] =>
for y in nameList repeat
e:= giveVariableSomeValue(y,D,e)
coerce([["PROGN",x,["%LET",nameList,g],g],m',e],m)
- -- 2. verify that the #nameList = number of parts of right-hand-side
+ -- 3. For a cross, do it by hand here instead of general mm. FIXME.
+ m1 is ['Cross,:.] =>
+ n := #m1.args
+ #nameList ~= n =>
+ stackMessage('"%1b must decompose into %2 components",[val,n])
+ stmts := nil
+ for y in nameList for t in m1.args for i in 0.. repeat
+ e := giveVariableSomeValue(y,t,e)
+ stmts := [['%LET,y,['%call,eltRecordFun(n,i),g,i]],:stmts]
+ coerce([['PROGN,x,:reverse! stmts,g],m1,e],m)
+ -- 4. verify that the #nameList = number of parts of right-hand-side
selectorModePairs:=
--list of modes
decompose(m1,#nameList,e) or return nil where
@@ -990,7 +1000,7 @@ setqMultiple(nameList,val,m,e) ==
stackMessage('"no multiple assigns to mode: %1p",[t])
#nameList~=#selectorModePairs =>
stackMessage('"%1b must decompose into %2 components",[val,#nameList])
- -- 3. generate code; return
+ -- 5. generate code; return
assignList:=
[([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
for x in nameList for [y,:z] in selectorModePairs]
@@ -1956,7 +1966,7 @@ compComma(form,m,e) ==
Tl' := [coerce(T,t) or return "failed" for T in Tl]
Tl' = "failed" => nil
[["asTupleNew0", ["getVMType",t], [T.expr for T in Tl']], m, e]
- T := [['%vector, :[T.expr for T in Tl]],
+ T := [['%call,mkRecordFun #argl,:[T.expr for T in Tl]],
["Cross",:[T.mode for T in Tl]], e]
coerce(T,m)
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 8a3254ac..c305a9bf 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -93,7 +93,8 @@ $DomainNames ==
SubDomain _
Union _
Record _
- Enumeration)
+ Enumeration _
+ Cross)
macro builtinFunctorName? x ==
symbolMember?(x,$DomainNames)