functor
import FD FS
export DomainProduct
define
fun {DecodeInt I Divs Doms}
case Divs#Doms
of nil#nil then nil
[] (Div|Divs)#(Dom|Doms) then
Q = I div Div
R = I mod Div
in
{Nth Dom Q+1}|{DecodeInt R Divs Doms}
end
end
class DomainProduct
feat range empty full
toint
attr divisors domains value2set
meth init(Domains)
Sizes = {Map Domains Length}
L1 = {Map Sizes fun {$ Size} _#Size end}
N = {FoldR L1 fun {$ M#N Accu} M=Accu N*Accu end 1}
Divs = {Map L1 fun {$ M#_} M end}
Val2Ints = {Dictionary.new}
in
for I in 1..N do
Tuple = {DecodeInt I-1 Divs Domains}
in
for V in Tuple do
{Dictionary.put Val2Ints V
I|{Dictionary.condGet Val2Ints V nil}}
end
end
divisors <- Divs
domains <- Domains
case Domains of [Dom] then
ToInt = {NewDictionary}
in
self.toint = ToInt
for K in Dom do
case Val2Ints.K of [I] then
ToInt.K := I
end
end
else self.toint=unit end
for K in {Dictionary.keys Val2Ints} do
Val2Ints.K := {FS.value.make Val2Ints.K}
end
self.range = 1#N
self.empty = FS.value.empty
self.full = {FS.value.make self.range}
value2set <- Val2Ints
end
meth encode(Desc $)
{self Disj(Desc $)}
end
meth Disj(Desc $)
case Desc
of _|_ then {FoldL Desc
fun {$ Accu Desc}
{FS.union Accu
{self Conj(Desc $)}}
end self.empty}
[] nil then self.empty
else @value2set.Desc end
end
meth Conj(Desc $)
case Desc
of _|_ then {FoldL Desc
fun {$ Accu Desc}
{FS.intersect Accu
{self Disj(Desc $)}}
end self.full}
[] nil then self.full
else @value2set.Desc end
end
meth decodeInt(I $)
{DecodeInt I-1 @divisors @domains}
end
meth decodeInts(L $)
{Map L fun {$ I} {self decodeInt(I $)} end}
end
meth decode(I $)
{self decodeInts({FD.reflect.domList I} $)}
end
meth decodeLo(S $)
{self decodeInts({FS.reflect.lowerBoundList S} $)}
end
meth decodeHi(S $)
{self decodeInts({FS.reflect.upperBoundList S} $)}
end
end
end