diff options
| -rw-r--r-- | src/ChangeLog | 13 | ||||
| -rw-r--r-- | src/algebra/triset.spad.pamphlet | 8 | ||||
| -rw-r--r-- | src/interp/cattable.boot | 2 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 18 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 3 |
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) |