BiRelDefaults.Mesa
Last tweaked by Mike Spreitzer on December 18, 1987 12:20:13 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, IntStuff, List, SetBasics;
BiRelDefaults:
CEDAR
PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
DefaultHasPair:
PUBLIC
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
spaces: SpacePair ~ br.Spaces[];
RETURN [br.ScanRestriction[[Sets.CreateSingleton[pair[left], spaces[left]], Sets.CreateSingleton[pair[right], spaces[right]]], AcceptAny].found]};
DefaultApply:
PUBLIC
PROC [br: BiRel, v: Value, dir: Direction]
RETURNS [mv: MaybeValue ← noMaybe] ~ {
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
n: LNAT ← 0;
Test:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
IF (n ← n + 1) > 1 THEN br.Complain[mappingNotSingleton, LIST[v]];
mv ← [TRUE, pair[dst]];
RETURN [FALSE]};
[] ← br.ScanRestriction[ConsSets[src, Sets.CreateSingleton[v, br.Spaces[][src]]], Test];
RETURN};
ImageSize:
PUBLIC
PROC [br: BiRel, set: Set, dir: Direction ← leftToRight, limit:
EINT ← lastEINT]
RETURNS [
EINT] ~ {
easy: BOOL ~ set.GoodImpl[$Size] AND set.Size[two].Compare[two]<equal;
IF easy THEN RETURN br.RestrictionSize[ConsSets[Source[dir], set], limit];
{image: Set ~ br.Image[set, dir];
RETURN set.DefaultSize[limit]}};
DefaultGetOne:
PUBLIC
PROC [br: BiRel, remove:
BOOL, ro: RelOrder]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
IF remove AND br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF Primitive[br, $ScanRestriction, refNilSets, FromRO[ro]]
THEN mp ← br.Scan[AcceptAny, ro]
ELSE {
spaces: SpacePair ~ br.Spaces[];
SeekBest:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
IF mp.found
THEN {IF ro.RelPCompare[spaces, pair, mp.it]=less THEN mp.it ← pair}
ELSE mp ← [TRUE, pair];
RETURN [FALSE]};
[] ← br.Scan[SeekBest];
ro ← ro};
IF mp.found AND remove THEN [] ← br.RemPair[mp.it];
RETURN};
DefaultGet3:
PUBLIC
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [TripleMaybePair] ~ {
ro ← ro.CanonizeRelOrder[br.Functional];
{fq, bq, nq: ImplQuality ← br.QualityOf[$Scan, FromRO[ro]];
rro: RelOrder;
IF ro.sub #
ALL[no]
THEN {
bq ← br.QualityOf[$Scan, FromRO[rro ← ro.ReverseRO[]]];
nq ← br.QualityOf[$Scan]};
{max: ImplQuality ~ QMax[nq, QMax[fq, bq]];
spaces: SpacePair ~ br.Spaces[];
prev, same, next: MaybePair ← noMaybePair;
IF fq=max
OR bq=max
THEN {
bwd: BOOL ~ bq=max AND fq<max;
take: BOOL ← FALSE;
Test:
PROC [this: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF PEqual[spaces, this, pair] THEN same ← [take ← TRUE, pair]
ELSE IF take THEN pass ← TRUE
ELSE prev ← [TRUE, this];
};
next ← br.Scan[Test, IF bwd THEN rro ELSE ro];
IF bwd THEN RETURN [[next, same, prev]];
RETURN [[prev, same, next]]}
ELSE {
foundSame: BOOL ← FALSE;
Test:
PROC [this: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
SELECT ro.RelPCompare[spaces, this, pair]
FROM
less => IF (NOT prev.found) OR ro.RelPCompare[spaces, this, prev.it]=greater THEN prev ← [TRUE, this];
equal => foundSame ← TRUE;
greater => IF (NOT next.found) OR ro.RelPCompare[spaces, this, next.it]=less THEN next ← [TRUE, this];
notrel => NULL;
ENDCASE => ERROR;
RETURN};
IF br.Scan[Test].found THEN ERROR;
RETURN [[prev, IF foundSame THEN [TRUE, pair] ELSE noMaybePair, next]]};
}}};
DefaultIndex:
PUBLIC
PROC [br, goal: IntRel, bounds: IntInterval, bwd:
BOOL]
RETURNS [MaybeValue] ~ {
ENABLE Cant => Cant[br];
right: Space ~ br.Spaces[][right];
brBounds: IntInterval ~ IF br.GoodImpl[$GetIntDom] THEN br.GetIntDom[] ELSE [];
goalBounds: IntInterval ~ goal.GetIntDom[];
goalLen: EINT ~ goalBounds.Length;
first: Set ~ IF goalBounds.Empty THEN nilSet ELSE goal.Mapping[IV[goalBounds.min]];
scanBounds: IntInterval ~ Intersect[
i scanBounds: i - goalBounds.min IN bounds
i scanBounds: i + goalBounds.Length-1 IN brBounds
bounds.ClipShiftInterval[IE[goalBounds.min]],
brBounds.ClipShiftInterval[one.Sub[goalLen]]];
Try:
PROC [i:
INT]
RETURNS [
BOOL] ~ {
IF first.Equal[br.Mapping[
IV[i]]]
THEN {
d: EINT ~ ISub[i, goalBounds.min];
FOR j:
INT
IN (goalBounds.min .. goalBounds.max]
DO
fm: Set ~ br.Mapping[IV[d.AddI[j].EI]];
gm: Set ~ goal.Mapping[IV[j]];
IF NOT fm.Equal[gm] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]};
RETURN [FALSE]};
IF goal.Empty THEN RETURN [[TRUE, IV[IF bwd THEN bounds.max ELSE bounds.min]]];
IF bwd
THEN
FOR i:
INT
DECREASING
IN [scanBounds.min .. scanBounds.max]
DO
IF Try[i] THEN RETURN [[TRUE, IV[i - goalBounds.min] ]];
ENDLOOP
ELSE
FOR i:
INT
IN [scanBounds.min .. scanBounds.max]
DO
IF Try[i] THEN RETURN [[TRUE, IV[i - goalBounds.min] ]];
ENDLOOP;
RETURN [noMaybe]};
DefaultRestrictionSize:
PUBLIC
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [size:
EINT ← zero] ~ {
Pass:
PROC [pair: Pair]
RETURNS [pass:
BOOL]
~ {
TRUSTED {size ← size.Succ[]};
pass ← limit.Compare[size] <= equal;
RETURN};
[] ← br.ScanRestriction[sets, Pass];
RETURN};
DefaultGetBounds:
PUBLIC
PROC [br: BiRel, want: EndBools, ro: RelOrder]
RETURNS [MaybePairInterval] ~ {
IF want = ALL[FALSE] THEN RETURN [[FALSE, ALL[noPair]]];
ro ← ro.CanonizeRelOrder[br.Functional[]];
{rro: RelOrder ~ ro.ReverseRO[];
IF
((NOT want[min]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[ro]]) AND
((NOT want[max]) OR Primitive[br, $ScanRestriction, fromNils, FromRO[rro]])
THEN {
bnds: PairInterval;
FOR e: End
IN End
DO
IF want[e]
THEN {
mp: MaybePair ← br.APair[IF e=min THEN ro ELSE rro];
IF NOT mp.found THEN GOTO Empty;
bnds[e] ← mp.it};
ENDLOOP;
RETURN [[TRUE, bnds]]}
ELSE {
spaces: SpacePair ~ br.Spaces[];
bnds: PairInterval ← ALL[ALL[noValue]];
first: BOOL ← TRUE;
Test:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
IF first
THEN {first ←
FALSE; bnds ← [pair, pair]}
ELSE {
IF want[min] THEN bnds[min] ← ro.RMin[spaces, bnds[min], pair];
IF want[max] THEN bnds[max] ← ro.RMax[spaces, bnds[max], pair]};
RETURN [FALSE]};
IF br.Scan[Test].found THEN ERROR;
IF first THEN GOTO Empty;
RETURN [[TRUE, bnds]]};
EXITS Empty => RETURN [[FALSE, ALL[noPair]]];
}};
fromNils: REF ANY ~ FromSets[[]];
DefaultCopy: PUBLIC PROC [br: BiRel] RETURNS [VarBiRel] ~ {br.Cant[]};
DefaultValueOf:
PUBLIC
PROC [br: BiRel]
RETURNS [ConstBiRel]
~ {IF br.MutabilityOf#constant THEN RETURN br.Copy.Freeze[] ELSE RETURN br.AsConst[]};
DefaultFreeze:
PUBLIC
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]; ERROR};
DefaultThaw:
PUBLIC
PROC [br: BiRel] ~ {
IF br.MutabilityOf#variable THEN br.Complain[notVariable] ELSE br.Cant[]};
DefaultSetOn:
PUBLIC
PROC [br: BiRel, side: Side]
RETURNS [UWSet] ~ {
RETURN br.Image[CreateFullSet[br.Spaces[][OtherSide[side]]], To[side]].Insulate};
DefaultCurSetOn:
PUBLIC
PROC [br: BiRel, side: Side]
RETURNS [ConstSet] ~ {
IF br.MutabilityOf=constant THEN RETURN br.SetOn[side].AsConst ELSE br.Cant};
DefaultAddPair:
PUBLIC
PROC [br: BiRel, pair: Pair, if: IfHadPair]
RETURNS [had: HadPair] ~ {
spaces: SpacePair ~ br.Spaces[];
IF Primitive[br, $AddSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.AddSet[CreateSingleton[pair, spaces], if] ]];
br.Cant[]};
DefaultAddSet:
PUBLIC
PROC [br, other: BiRel, if: IfHadPair]
RETURNS [some: HadSetPair ←
ALL[
ALL[
FALSE]]] ~ {
AddThisPair:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
had: HadPair ~ br.AddPair[pair, if];
some[leftToRight][had[leftToRight]] ← TRUE;
some[rightToLeft][had[rightToLeft]] ← TRUE;
RETURN [FALSE]};
IF NOT Primitive[br, $AddPair] THEN br.Cant[];
IF other.Scan[AddThisPair].found THEN ERROR;
RETURN};
DefaultSwap:
PUBLIC
PROC [br: BiRel, a, b: Value, side: Side] ~ {
spaces: SpacePair ~ br.Spaces[];
IF spaces[side].SEqual[a, b] THEN RETURN;
{dir: Direction ~ From[side];
other: Side ~ OtherSide[side];
am: Set ~ br.Mapping[a, dir].CreateHashCopy[];
patt: Pair ← ALL[a];
Movit:
PROC [v: Value]
RETURNS [
BOOL] ~ {
patt[other] ← v;
[] ← br.AddPair[patt];
RETURN [FALSE]};
[] ← br.Delete[a, side];
IF br.ScanMapping[b, Movit, dir].found THEN ERROR;
[] ← br.Delete[b, side];
patt ← ALL[b];
IF am.Scan[Movit].found THEN ERROR;
RETURN}};
DefaultRemPair:
PUBLIC
PROC [br: BiRel, pair: Pair]
RETURNS [had: HadPair] ~ {
spaces: SpacePair ~ br.Spaces[];
IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.class.RemSet[br, CreateSingleton[pair, spaces]]]];
br.Cant[]};
DefaultRemSet:
PUBLIC
PROC [br, other: BiRel]
RETURNS [some: HadSetPair] ~ {
RemThisPair:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
had: HadPair ~ br.RemPair[pair];
some[leftToRight][had[leftToRight]] ← TRUE;
some[rightToLeft][had[rightToLeft]] ← TRUE;
RETURN [FALSE]};
IF NOT Primitive[br, $RemPair] THEN br.Cant[];
IF other.Scan[RemThisPair].found THEN ERROR;
RETURN};
DefaultDelete:
PUBLIC
PROC [br: BiRel, val: Value, side: Side]
RETURNS [hadSome:
BOOL ←
FALSE] ~ {
srcSpace: Space ~ br.Spaces[][side];
IF Primitive[br, $DeleteSet, Sets.FakeRefSingleton[srcSpace], FromSide[side]]
THEN RETURN [br.class.DeleteSet[br, Sets.CreateSingleton[val, srcSpace], side].had.some];
{other: Side ~ OtherSide[side];
dir: Direction ~ From[side];
pair: Pair ← ALL[val];
KillPair:
PROC [v2: Value]
RETURNS [
BOOL] ~ {
pair[other] ← v2;
[] ← br.RemPair[pair];
hadSome ← TRUE;
RETURN [FALSE]};
IF br.ScanMapping[val, KillPair, dir].found THEN ERROR;
RETURN}};
DefaultDeleteSet:
PUBLIC
PROC [br: BiRel, set: Set, side: Side]
RETURNS [had: SomeAll ← []] ~ {
other: Side ~ OtherSide[side];
dir: Direction ~ From[side];
easy: BOOL ~ Primitive[br, $Delete, FromSide[side]];
EasyKill:
PROC [val: Value]
RETURNS [
BOOL] ~ {
IF br.Delete[val, side] THEN had.some ← TRUE ELSE had.all ← FALSE;
RETURN [FALSE]};
HardKill:
PROC [val: Value]
RETURNS [
BOOL] ~ {
pair: Pair ← ALL[val];
HardKillPair:
PROC [v2: Value]
RETURNS [
BOOL] ~ {
pair[other] ← v2;
[] ← br.RemPair[pair];
some ← TRUE;
RETURN [FALSE]};
some: BOOL ← FALSE;
IF br.ScanMapping[val, HardKillPair, dir].found THEN ERROR;
IF some THEN had.some ← TRUE ELSE had.all ← FALSE;
RETURN [FALSE]};
IF set.Scan[IF easy THEN EasyKill ELSE HardKill].found THEN ERROR;
RETURN};
END.