BiRelStds.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 4:43:23 pm PST
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.