BiRelsAsSets.Mesa
Last tweaked by Mike Spreitzer on December 18, 1987 12:26:19 pm PST
DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;
BiRelsAsSets:
CEDAR
PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, SetBasics
EXPORTS BiRels
=
BEGIN OPEN SetBasics, BiRelBasics, BiRels, Sets:AbSets, Sets;
Widening: TYPE ~ REF WideningPrivate;
WideningPrivate: TYPE ~ RECORD [br: BiRel, ro, rro: BiRels.TotalRelOrder];
DefaultAsSet:
PUBLIC
PROC [br: BiRel, ro: BiRels.RelOrder]
RETURNS [Set
--of REF Pair--] ~ {
ro ← CanonizeRelOrder[ro, br.Functional[]];
FOR s: Side IN Side DO IF ro.sub[s]=no THEN ro.sub[s] ← fwd ENDLOOP;
{w: Widening ~ NEW [WideningPrivate ← [br, ro, ro.ReverseRO[]]];
RETURN [[wideClasses[br.MutabilityOf[]], AV[w] ]]}};
WideClasses: TYPE ~ ARRAY Mutability OF SetClass;
wideClasses: REF WideClasses ~ NEW [WideClasses];
WidePrimitive:
PROC [set: Set, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
w: Widening ~ NARROW[set.data.VA];
SELECT op
FROM
$HasMember, $QuaBiRel, $QuaIntInterval => RETURN [yes];
$Scan => RETURN [IF w.br.Can[op] THEN yes ELSE no];
$Size, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $GetOne => RETURN [IF w.br.Can[op, arg1] THEN yes ELSE no];
$Get3 => RETURN [IF w.br.Can[$Get3, BiRels.FromRO[[ALL[fwd]]]] THEN yes ELSE no];
$GetBounds => {
want: EndBools ~ ToEB[arg1];
RETURN [IF w.br.Can[$GetBounds, FromEB[want], BiRels.FromRO[w.ro]] THEN yes ELSE no]};
$AddSet, $RemSet => {other: Set ~ DeRef[arg1];
obr: BiRel ~ SetAsBiRel[other];
RETURN [IF w.br.Can[op, obr.Refify] THEN yes ELSE no]};
ENDCASE => RETURN [pass];
};
WideHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.HasPair[Nv[elt]]};
WideScan:
PROC [set: Set,
Test: Tester, ro: RelOrder]
RETURNS [MaybeValue] ~ {
w: Widening ~ NARROW[set.data.VA];
Pass: PROC [pair: Pair] RETURNS [BOOL] --BiRels.Tester-- ~ {RETURN Test[Wp[pair]]};
RETURN Wmp[w.br.Scan[Pass, Nro[w, ro]]]};
WideGetOne:
PROC [set: Set, remove:
BOOL, ro: RelOrder]
RETURNS [MaybeValue] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN Wmp[w.br.GetOne[remove, Nro[w, ro]]]};
WideGet3:
PROC [set: Set, elt: Value, want: TripleBool]
RETURNS [TripleMaybeValue] ~ {
w: Widening ~ NARROW[set.data.VA];
tmp: TripleMaybePair ~ w.br.Get3[Nv[elt], w.ro, want];
RETURN [[Wmp[tmp.prev], Wmp[tmp.same], Wmp[tmp.next]]]};
WideSize:
PROC [set: Set, limit:
EINT]
RETURNS [
EINT] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.Size[limit]};
WideGetBounds:
PROC [set: Set, want: EndBools]
RETURNS [MaybeInterval] ~ {
w: Widening ~ NARROW[set.data.VA];
mpi: MaybePairInterval ~ w.br.GetBounds[want, w.ro];
IF NOT mpi.found THEN RETURN [[FALSE, []]];
RETURN [[TRUE, [Wp[mpi.it[min]], Wp[mpi.it[max]]]]]};
WideCopy:
PROC [set: Set]
RETURNS [VarSet] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.Copy.AsSet[w.ro].AsVar};
WideInsulate:
PROC [set: Set]
RETURNS [UWSet] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.Insulate.AsSet[w.ro].AsUW};
WideValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.ValueOf.AsSet[w.ro].AsConst};
WideFreeze:
PROC [set: Set]
RETURNS [ConstSet] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN w.br.Freeze.AsSet[w.ro].AsConst};
WideThaw:
PROC [set: Set] ~ {
w: Widening ~ NARROW[set.data.VA];
w.br.Thaw[];
RETURN};
WideAddSet:
PROC [set, other: Set]
RETURNS [new: SomeAll ← []] ~ {
w: Widening ~ NARROW[set.data.VA];
fnl: BoolPair ~ w.br.Functional[];
IF fnl #
ALL[
FALSE]
THEN {
obr: BiRel ~ SetAsBiRel[other];
some: HadSetPair ~ w.br.AddSet[obr];
dir: Direction ~ IF fnl[leftToRight] THEN leftToRight ELSE rightToLeft;
RETURN [[some: some[dir][none] OR some[dir][different], all: NOT some[dir][same]]];
}
ELSE {
Addit:
PROC [val: Value] ~ {
pair: Pair ~ Nv[val];
IF w.br.HasPair[pair] THEN new.all ← FALSE ELSE new.some ← TRUE;
[] ← w.br.AddPair[pair];
RETURN};
other.Enumerate[Addit];
RETURN};
};
WideRemSet:
PROC [set, other: Set]
RETURNS [had: SomeAll ← []] ~ {
w: Widening ~ NARROW[set.data.VA];
fnl: BoolPair ~ w.br.Functional[];
IF fnl #
ALL[
FALSE]
THEN {
obr: BiRel ~ SetAsBiRel[other];
dir: Direction ~ IF fnl[leftToRight] THEN leftToRight ELSE rightToLeft;
some: HadSetPair ~ w.br.RemSet[obr];
RETURN [[some: some[dir][same], all: NOT (some[dir][none] OR some[dir][different])]];
}
ELSE {
Remit:
PROC [val: Value] ~ {
pair: Pair ~ Nv[val];
IF w.br.HasPair[pair] THEN had.some ← TRUE ELSE had.all ← FALSE;
[] ← w.br.RemPair[pair];
RETURN};
other.Enumerate[Remit];
RETURN};
};
WideQuaBiRel:
PROC [set: Set]
RETURNS [found:
BOOL, class, data:
REF
ANY] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN [TRUE, w.br.class, w.br.data]};
WideQuaIntInterval:
PROC [set: Set]
RETURNS [MaybeIntInterval] ~ {
RETURN [[FALSE, [INT.LAST, INT.FIRST]]]};
WideSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
w: Widening ~ NARROW[set.data.VA];
RETURN WidenPairSpace[[w.br.Spaces[], w.ro]]};
Nv:
PROC [v: Value]
RETURNS [Pair]
~ INLINE {RETURN [NARROW[v.VA, REF Pair]^]};
Wp:
PROC [p: Pair]
RETURNS [Value]
~ INLINE {RETURN [AV[NEW [Pair ← p]]]};
Wmp:
PROC [mp: MaybePair]
RETURNS [MaybeValue]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.it]] ELSE noMaybe]};
Nro:
PROC [w: Widening, ro: RelOrder]
RETURNS [BiRels.RelOrder]
~
INLINE {
RETURN [
SELECT ro
FROM
no => [],
fwd => w.ro,
bwd => w.rro,
ENDCASE => ERROR]};
Start:
PROC ~ {
FOR mut: Mutability
IN Mutability
DO
wideClasses[mut] ← CreateClass[[
Primitive: WidePrimitive,
HasMember: WideHasMember,
Scan: WideScan,
GetOne: WideGetOne,
Get3: WideGet3,
Size: WideSize,
GetBounds: WideGetBounds,
Copy: WideCopy,
Insulate: IF mut=variable THEN WideInsulate ELSE NIL,
ValueOf: IF mut#constant THEN WideValueOf ELSE NIL,
Freeze: IF mut=variable THEN WideFreeze ELSE NIL,
Thaw: IF mut=variable THEN WideThaw ELSE NIL,
AddSet: IF mut=variable THEN WideAddSet ELSE NIL,
RemSet: IF mut=variable THEN WideRemSet ELSE NIL,
QuaBiRel: WideQuaBiRel,
QuaIntInterval: WideQuaIntInterval,
SpaceOf: WideSpaceOf,
mutability: mut]];
ENDLOOP;
RETURN};
Start[];
END.