DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;

BiRelStds: CEDAR PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics
EXPORTS BiRels
=

BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;

Lyst: TYPE ~ REF LystPrivate;
LystPrivate: TYPE ~ RECORD [
spaces: SpacePair,
vals: LOP _ NIL,
ro: --Canonical--RelOrder,
size, freezeCount: LNAT _ 0
];

CreateList: PUBLIC PROC [vals: LOP, functional: BoolPair _ [FALSE, FALSE], spaces: SpacePair _ [basic, basic], mutability: Mutability _ variable, order: RelOrder _ [], assumeSorted: BOOL _ FALSE] RETURNS [br: VarBiRel] ~ {
cro: RelOrder ~ order.CanonizeRelOrder[functional];
l: Lyst ~ NEW [LystPrivate _ [spaces, NIL, cro]];
br _ AsVar[[listClasses [functional[leftToRight]] [functional[rightToLeft]] [mutability], l]];
IF order=[] THEN assumeSorted _ TRUE;
IF assumeSorted THEN {
l.vals _ vals;
FOR vals _ vals, vals.rest WHILE vals#NIL DO l.size _ l.size+1 ENDLOOP;
}
ELSE {
FOR vals _ vals, vals.rest WHILE vals#NIL DO
[] _ br.AddPair[vals.first];
ENDLOOP;
};
RETURN};

ListClasses: TYPE ~ ARRAY --functional[leftToRight]--BOOL OF ARRAY --functional[rightToLeft]--BOOL OF ARRAY Mutability OF BiRelClass;
listClasses: REF ListClasses ~ NEW [ListClasses];

LystPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ {
l: Lyst ~ NARROW[br.data];
SELECT op FROM
$ScanRestriction => {
cro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional];
RETURN [IF NOT cro.Coarser[l.ro] THEN no ELSE yes]};
$RestrictionSize => {
sets: RefSetPair ~ ToSets[arg1];
RETURN [IF sets^#ALL[nilSet] THEN no ELSE yes]};
ENDCASE => RETURN [pass]};

LystScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ {
l: Lyst ~ NARROW[br.data];
nl: BOOL ~ sets[left]=nilSet;
nr: BOOL ~ sets[right]=nilSet;
cro: RelOrder ~ ro.CanonizeRelOrder[br.Functional];
IF br.MutabilityOf=constant AND l.freezeCount=0 THEN br.Complain[unfrozen];
IF NOT cro.Coarser[l.ro] THEN RETURN DefaultScanRestriction[br, sets, Test, cro];
FOR vals: LOP _ l.vals, vals.rest WHILE vals#NIL DO
IF
(nl OR sets[left].HasMember[vals.first[left]]) AND
(nr OR sets[right].HasMember[vals.first[right]]) AND
Test[vals.first]
THEN RETURN [[TRUE, vals.first]];
ENDLOOP;
RETURN [noMaybePair]};

LystRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ~ {
l: Lyst ~ NARROW[br.data];
IF br.MutabilityOf=constant AND l.freezeCount=0 THEN br.Complain[unfrozen];
IF sets#ALL[nilSet] THEN RETURN DefaultRestrictionSize[br, sets, limit];
RETURN [IE[l.size]]};

LystCopy: PROC [br: BiRel] RETURNS [copy: VarBiRel] ~ {
l: Lyst ~ NARROW[br.data];
IF br.MutabilityOf=constant AND l.freezeCount=0 THEN br.Complain[unfrozen];
copy _ CreateList[NIL, br.Functional, br.Spaces, br.MutabilityOf, l.ro];
[] _ copy.AddSet[br];
RETURN};

LystInsulate: PROC [br: BiRel] RETURNS [UWBiRel] ~ {
l: Lyst ~ NARROW[br.data];
functional: BoolPair ~ br.Functional;
RETURN AsUW[[listClasses [functional[leftToRight]] [functional[rightToLeft]] [readonly], l]]};

LystFreeze: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
l: Lyst ~ NARROW[br.data];
functional: BoolPair ~ br.Functional;
l.freezeCount _ l.freezeCount+1;
RETURN AsConst[[listClasses [functional[leftToRight]] [functional[rightToLeft]] [constant], l]]};

LystThaw: PROC [br: BiRel] ~ {
l: Lyst ~ NARROW[br.data];
SELECT l.freezeCount FROM
>0 => l.freezeCount _ l.freezeCount-1;
=0 => br.Complain["attempt to thaw a non-frozen variable collection %g"];
ENDCASE => ERROR;
RETURN};

LystAddSet: PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair _ ALL[ALL[FALSE]]] ~ {
l: Lyst ~ NARROW[br.data];
s1: Side ~ l.ro.first;
s2: Side ~ OtherSide[s1];
d1: Direction ~ From[s1];
d2: Direction ~ From[s2];
f1: BOOL ~ br.Functional[][d1];
f2: BOOL ~ br.Functional[][d2];
last: LOP _ NIL;
cur: LOP _ l.vals;
fromScratch: BOOL ~ f2 OR NOT other.GoodImpl[$Scan, FromRO[l.ro]];
Addit: PROC [this: LOP] ~ INLINE {
IF last=NIL THEN l.vals _ this ELSE last.rest _ this;
l.size _ l.size+1;
last _ this};
AddPair: PROC [pair: Pair] RETURNS [BOOL] ~ {
notin: BOOL _ TRUE;
unseen1: BOOL _ f1;
unseen2: BOOL _ f2;
IF fromScratch THEN {cur _ l.vals; last _ NIL};
WHILE cur#NIL DO
cp: ComPair ~ Compair[l.spaces, pair, cur.first];
rcp: PComPair ~ RelativizeComPair[l.ro.sub, cp];
IF unseen1 THEN SELECT rcp[s1] FROM
greater, notrel => NULL;
equal => {
unseen1 _ FALSE;
IF cp[s2]=equal THEN some[d1][same] _ TRUE ELSE {
some[d1][different] _ TRUE;
TRUSTED {cur.first[s2] _ pair[s2]};
notin _ FALSE}};
less => {unseen1 _ FALSE; some[d1][none] _ TRUE};
ENDCASE => ERROR;
IF unseen2 AND cp[s2]=equal THEN {
unseen2 _ FALSE;
IF cp[s1]=equal THEN some[d2][same] _ TRUE ELSE {
some[d2][different] _ TRUE;
TRUSTED {cur.first[s1] _ pair[s1]};
notin _ FALSE}};
SELECT LexizePComPair[rcp, s1] FROM
greater, notrel => NULL;
equal => notin _ FALSE;
less => IF notin THEN {Addit[CONS[pair, cur]]; notin _ FALSE};
ENDCASE => ERROR;
IF NOT (notin OR unseen1 OR unseen2) THEN EXIT;
last _ cur;
cur _ cur.rest;
ENDLOOP;
IF notin THEN Addit[LIST[pair]];
IF unseen1 THEN some[d1][none] _ TRUE;
IF unseen2 THEN some[d2][none] _ TRUE;
RETURN [FALSE]};
IF l.freezeCount#0 THEN br.Complain[frozen];
IF other.Scan[AddPair, IF fromScratch THEN [] ELSE l.ro].found THEN ERROR;
RETURN};

LystRemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair _ []] ~ {
l: Lyst ~ NARROW[br.data];
s1: Side ~ l.ro.first;
s2: Side ~ OtherSide[s1];
d1: Direction ~ From[s1];
d2: Direction ~ From[s2];
f1: BOOL ~ br.Functional[][d1];
f2: BOOL ~ br.Functional[][d2];
last: LOP _ NIL;
cur: LOP _ l.vals;
fromScratch: BOOL ~ f2 OR NOT other.GoodImpl[$Scan, FromRO[l.ro]];
Remit: PROC ~ INLINE {
IF last=NIL THEN l.vals _ cur.rest ELSE last.rest _ cur.rest;
l.size _ l.size-1;
cur _ cur.rest};
Advance: PROC ~ INLINE {last _ cur; cur _ cur.rest};
RemPair: PROC [pair: Pair] RETURNS [BOOL] ~ {
in: BOOL _ TRUE;
unseen1: BOOL _ f1;
unseen2: BOOL _ f2;
IF fromScratch THEN {cur _ l.vals; last _ NIL};
WHILE cur#NIL DO
cp: ComPair ~ Compair[l.spaces, pair, cur.first];
rcp: PComPair ~ RelativizeComPair[l.ro.sub, cp];
IF unseen1 THEN SELECT rcp[s1] FROM
greater, notrel => NULL;
equal => {unseen1 _ FALSE; some[d1][IF cp[s2]=equal THEN same ELSE different] _ TRUE};
less => {unseen1 _ FALSE; some[d1][none] _ TRUE};
ENDCASE => ERROR;
IF unseen2 AND cp[s2]=equal THEN {unseen2 _ FALSE; some[d2][IF cp[s1]=equal THEN same ELSE different] _ TRUE};
SELECT LexizePComPair[rcp, s1] FROM
greater, notrel => Advance[];
equal => {Remit[]; in _ FALSE; IF NOT (in OR unseen1 OR unseen2) THEN EXIT};
less => {in _ FALSE; IF NOT (in OR unseen1 OR unseen2) THEN EXIT; Advance[]};
ENDCASE => ERROR;
in _ in; ENDLOOP;
IF unseen1 THEN some[d1][none] _ TRUE;
IF unseen2 THEN some[d2][none] _ TRUE;
RETURN [FALSE]};
IF l.freezeCount#0 THEN br.Complain[frozen];
IF other.Scan[RemPair, IF fromScratch THEN [] ELSE l.ro].found THEN ERROR;
RETURN};

LystDeleteSet: PROC [br: BiRel, set: Set, side: Side] RETURNS [had: SomeAll _ []] ~ {
l: Lyst ~ NARROW[br.data];
s1: Side ~ l.ro.first;
s2: Side ~ OtherSide[s1];
d1: Direction ~ From[s1];
d2: Direction ~ From[s2];
f1: BOOL ~ s1=side;
f2: BOOL ~ s2=side;
roa: Sets.RelOrder ~ l.ro.sub[side];
spacea: Space ~ br.Spaces[][side];
last: LOP _ NIL;
cur: LOP _ l.vals;
fromScratch: BOOL ~ f2 OR NOT set.GoodImpl[$Scan, Sets.FromRO[roa]];
Remit: PROC ~ INLINE {
IF last=NIL THEN l.vals _ cur.rest ELSE last.rest _ cur.rest;
l.size _ l.size-1;
cur _ cur.rest};
Advance: PROC ~ INLINE {last _ cur; cur _ cur.rest};
RemElt: PROC [val: Value] RETURNS [BOOL] ~ {
unseen1: BOOL _ f1;
unseen2: BOOL _ f2;
IF fromScratch THEN {cur _ l.vals; last _ NIL};
WHILE cur#NIL DO
c: PartialComparison ~ roa.RelPCompare[spacea, val, cur.first[side]];
rc: PartialComparison ~ IF f1 THEN c ELSE IF c=equal THEN c ELSE notrel;
IF unseen1 THEN SELECT c FROM
greater, notrel => NULL;
equal => {unseen1 _ FALSE; had.some _ TRUE};
less => {unseen1 _ FALSE; had.all _ FALSE};
ENDCASE => ERROR;
IF unseen2 AND c=equal THEN {unseen2 _ FALSE; had.some _ TRUE};
SELECT rc FROM
greater, notrel => Advance[];
equal => Remit[];
less => EXIT;
ENDCASE => ERROR;
side _ side; ENDLOOP;
IF unseen1 OR unseen2 THEN had.all _ FALSE;
RETURN [FALSE]};
IF l.freezeCount#0 THEN br.Complain[frozen];
IF set.Scan[RemElt, IF fromScratch THEN no ELSE roa].found THEN ERROR;
RETURN};

LystSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ {
l: Lyst ~ NARROW[br.data];
RETURN [l.spaces]};

Start: PROC ~ {
FOR l2r: BOOL IN BOOL DO FOR r2l: BOOL IN BOOL DO FOR mut: Mutability IN Mutability DO
listClasses[l2r][r2l][mut] _ CreateClass[
cp: [
Primitive: LystPrimitive,
ScanRestriction: LystScanRestriction,
RestrictionSize: LystRestrictionSize,
Copy: LystCopy,
Insulate: IF mut=variable THEN LystInsulate ELSE NIL,
Freeze: IF mut=variable THEN LystFreeze ELSE NIL,
Thaw: IF mut=variable THEN LystThaw ELSE NIL,
AddSet: IF mut=variable THEN LystAddSet ELSE NIL,
RemSet: IF mut=variable THEN LystRemSet ELSE NIL,
DeleteSet: IF mut=variable THEN LystDeleteSet ELSE NIL,
Spaces: LystSpaces,
functional: [l2r, r2l],
mutability: mut],
dirable: ALL[TRUE]
];
ENDLOOP ENDLOOP ENDLOOP;
};

Start[];

END.
XBiRelStds.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 4:43:23 pm PST
Κ
k–

"cedar" style˜
codeš
œ™Kš
œB™B—K˜KšΟk	œ2˜;K˜šΟn	œœ
˜Kšœ1˜8Kšœ˜K˜
—K˜Kšœ
œžœ#˜GK˜Kšœœœ
˜šœ
œœ˜K˜Kšœœœ
˜KšœΟc
œ	˜Kšœœ˜K˜—K˜šž
œœ
œœœœnœœœ˜ή
Kš
œ3˜3Kšœ
œœ˜1Kš
œ^˜^Kšœ
œœ
˜%šœœ˜K˜Kš
œœœ
œœ
˜GK˜
—šœ˜šœœœ
˜,K˜Kšœ
˜—Kš
œ˜—Kšœ˜—K˜Kšœ
œœ
Ÿœ
œ
œ
Ÿœ
œ
œœ˜…
Kšœ
œœ˜1K˜šž
œœœœ
œœ˜\Kšœ
œ
˜šœ˜š
œ˜Kš
œ;˜;Kš
œœ
œœœ˜4—š
œ˜Kš
œ ˜ Kš
œœœ	œœ˜0—Kšœœ	˜——K˜šžœœžœœ˜hKšœ
œ
˜Kšœœ˜Kšœœ˜Kš
œ3˜3Kšœœœ˜KKšœ
œœ
œ-˜Qš	œœœœ
˜3š
˜Kšœœ)˜2Kšœœ+˜4Kš
œ˜—Kšœ
œœ˜!Kšœ
˜—Kšœ˜—K˜š
žœœ#œœœ˜TKšœ
œ
˜Kšœœœ˜KKšœœ	œ
œ)˜HKšœœ˜—K˜šžœœ
œ˜7Kšœ
œ
˜Kšœœœ˜KKšœœ3˜HK˜Kšœ˜—K˜šžœœ
œ˜4Kšœ
œ
˜Kš
œ%˜%KšœX˜^—K˜šž
œœ
œ˜5Kšœ
œ
˜Kš
œ%˜%Kš
œ ˜ Kšœ[˜a—K˜šžœœ˜Kšœ
œ
˜šœ˜Kš
œ&˜&Kš
œI˜IKšœœ
˜—Kšœ˜—K˜šž
œœ#œœ
œ
œ˜cKšœ
œ
˜K˜K˜K˜K˜Kšœœ˜Kšœœ˜Kšœœœ
˜Kšœœ
˜Kšœ
œœ
œ%˜Bšžœœœœ˜"Kšœœ
œœ˜5K˜Kš
œ
˜
—šžœœœœ˜-Kšœœœ
˜Kšœ	œ˜Kšœ	œ˜Kšœ
œœ˜/šœœ
˜K˜1Kš
œ0˜0šœ	œ
œ	˜#Kšœœ
˜š
œ
˜
Kšœ
œ
˜šœœœ
œ˜1Kšœœ
˜Kšœ˜#Kšœœ˜——Kšœœœ˜1Kšœœ
˜—šœ	œœ˜"Kšœ
œ
˜šœœœ
œ˜1Kšœœ
˜Kšœ˜#Kšœœ˜——šœ˜#Kšœœ
˜Kšœœ
˜Kš	œœœœœ˜>Kšœœ
˜—Kšœ
œœ	œ
œ
œ
˜/K˜K˜Kšœ
˜—Kšœœœ˜ Kšœ	œœ
˜&Kšœ	œœ
˜&Kšœœ˜—Kšœœ˜,Kšœœ
œœ
œ
œ
˜JKšœ˜—K˜šž
œœœ˜GKšœ
œ
˜K˜K˜K˜K˜Kšœœ˜Kšœœ˜Kšœœœ
˜Kšœœ
˜Kšœ
œœ
œ%˜Bšžœœœ˜Kšœœ
œœ˜=K˜Kš
œ˜—Kšžœœœ˜4šžœœœœ˜-Kšœœœ
˜Kšœ	œ˜Kšœ	œ˜Kšœ
œœ˜/šœœ
˜K˜1Kš
œ0˜0šœ	œ
œ	˜#Kšœœ
˜Kšœœœœœœ˜VKšœœœ˜1Kšœœ
˜—Kšœ	œœœœœœœ˜nšœ˜#Kš
œ˜Kšœœœ
œœ	œ
œ
œ˜LKšœœœ
œœ	œ
œ
œ
˜MKšœœ
˜—Kšœ	œ
˜—Kšœ	œœ
˜&Kšœ	œœ
˜&Kšœœ˜—Kšœœ˜,Kšœœ
œœ
œ
œ
˜JKšœ˜—K˜šž
œœ#œ˜UKšœ
œ
˜K˜K˜K˜K˜Kšœœ˜Kšœœ˜Kš
œ$˜$K˜"Kšœœœ
˜Kšœœ
˜Kšœ
œœ
œ'˜Dšžœœœ˜Kšœœ
œœ˜=K˜Kš
œ˜—Kšžœœœ˜4šžœœœœ˜,Kšœ	œ˜Kšœ	œ˜Kšœ
œœ˜/šœœ
˜Kš
œE˜EKš
œœœœ
œ	œœ˜Hšœ	œ
œ˜Kšœœ
˜Kšœœ
œ˜,Kšœœœ˜+Kšœœ
˜—Kš
œ	œ	œœ
œ˜?šœ˜Kš
œ˜Kš
œ˜Kšœœ
˜
Kšœœ
˜—Kšœ
œ
˜—Kšœ	œ	œœ
˜+Kšœœ˜—Kšœœ˜,Kšœœ
œœœ
œ
˜FKšœ˜—K˜šž
œœ
œ˜4Kšœ
œ
˜Kšœ
˜—K˜šžœœ˜šœœ
œ
œ
œ
œœ
œ
œ
œ
œœ˜Vš
œ)˜)˜Kšž	œ˜Kšžœ˜%Kšžœ˜%Kšžœ˜Kš
žœœœœ
œ
˜5Kš
žœœœœ
œ
˜1Kš
žœœœ
œ
œ
˜-Kš
žœœœœ
œ
˜1Kš
žœœœœ
œ
˜1Kš
ž	œœœœ
œ
˜7Kšžœ
˜Kš
œ˜K˜—Kšœ	œ
œ
˜K˜—Kšœ
œ
œ
˜—K˜—K˜K˜K˜Kšœ
˜—…—#Ύ1