[Indigo]<Voice>Triples>TriplesImpl.mesa!1

TriplesImpl.Mesa

Last Modified by Paul Rovner on 23-Apr-81 17:59:27

Last Edited by: Swinehart, April 3, 1987 5:10:22 pm PST, Callbacks, with monitor unlocked (!)

DIRECTORY

Basics USING[BITAND, BITXOR, LongNumber, LowHalf],

Triples;

TriplesImpl: CEDAR MONITOR IMPORTS Basics EXPORTS Triples

= BEGIN OPEN Triples;

TYPES

AOHashVec: TYPE = ARRAY AOHashVecIndex OF AOHashList; -- each ordered by att

AOHashVecIndex: TYPE = [0..AOHashVecLength);

AOHashVecLength: CARDINAL = 10000B;

AOHashList: TYPE = LIST OF AOHashTriple;

AOHashTriple: TYPE = RECORD[

triple: Triple←NIL,

aLink, oLink, vLink: AOHashList←NIL];

ItemHashVec: TYPE = ARRAY ItemHashVecIndex OF ItemHashList;

ItemHashVecIndex: TYPE = [0..ItemHashVecLength);

ItemHashVecLength: CARDINAL = 4000B;

ItemHashList: TYPE = LIST OF ItemLinkHen;

ItemLinkHen: TYPE = RECORD[hen: AOHashList, -- unordered

henType: HenType];

HenType: TYPE = {att, obj, val};

TripleArgPattern: TYPE = {aov, aox, axv, xov, axx, xox, xxv, xxx};

SIGNALS

ArgFault: PUBLIC ERROR[att, obj, val: Item] = CODE;

VARIABLES

itemHashVec: REF ItemHashVec ← NEW[ItemHashVec ← ALL[NIL]];

aoHashVec: REF AOHashVec ← NEW[AOHashVec ← ALL[NIL]];

PUBLIC PROCs

Make: PUBLIC ENTRY PROC[att, obj, val: Item] =

{ ENABLE UNWIND => NULL;

IF att = Any OR obj = Any OR val = Any THEN ERROR ArgFault[att, obj, val];

{ ahl: ItemHashList ← FindALink[att];

ohl: ItemHashList ← FindOLink[obj];

vhl: ItemHashList ← FindVLink[val];

aohi: AOHashVecIndex ← AOHash[att, obj];

aohl: AOHashList ← aoHashVec[aohi];

prev, rest: AOHashList ← NIL;

UNTIL aohl = NIL DO

t: Triple = aohl.first.triple;

IF att = t.att THEN

IF obj = t.obj AND val = t.val THEN RETURN

ELSE {prev ← aohl; aohl ← aohl.rest; LOOP}

ELSE IF LOOPHOLE[att, LONG CARDINAL] > LOOPHOLE[t.att, LONG CARDINAL] THEN

{prev ← aohl; aohl ← aohl.rest; LOOP}

ELSE EXIT;

ENDLOOP;

rest ← IF prev = NIL THEN aoHashVec[aohi] ELSE prev.rest;

aohl ← CONS[[triple: NEW[TripleRec ← [att, obj, val]],

aLink: ahl.first.hen,

oLink: ohl.first.hen,

vLink: vhl.first.hen

rest];

IF prev = NIL THEN aoHashVec[aohi] ← aohl ELSE prev.rest ← aohl;

ahl.first.hen ← ohl.first.hen ← vhl.first.hen ← aohl;

};

Foreach: PUBLIC PROC[att, obj, val: Item, proc: ForeachProc]= {

aohl: AOHashList;

ihl: ItemHashList;

index: ItemHashVecIndex𡤀

pattern: TripleArgPattern=Pattern[att, obj, val];

first: BOOL←TRUE;

nextTriple: TripleRec;

Next: ENTRY PROC[] RETURNS[more: BOOLEAN←TRUE] = INLINE {

ENABLE UNWIND => NULL;

t: Triple←NIL;

IF first THEN SELECT pattern FROM

aov, aox => aohl ← aoHashVec[AOHash[att, obj]];

axv, xov, xxv => {

vhl: ItemHashList = FindVLink[val];

aohl ← vhl.first.hen;

IF aohl = NIL THEN RemoveEmptyVHen[val, vhl]; };

axx => {

ahl: ItemHashList = FindALink[att];

aohl ← ahl.first.hen;

IF aohl = NIL THEN RemoveEmptyAHen[att, ahl]; };

xox => {

ohl: ItemHashList = FindOLink[obj];

aohl ← ohl.first.hen;

IF aohl = NIL THEN RemoveEmptyOHen[obj, ohl]; };

xxx => ihl ←

CONS[[hen: NIL, henType: att], itemHashVec[index -- 0 --]];

ENDCASE => ERROR;

SELECT pattern FROM

aov, aox =>

FOR aohl←IF ~first THEN aohl.rest ELSE aohl, aohl.rest UNTIL aohl=NIL DO

t← aohl.first.triple;

IF att = t.att THEN {

IF obj = t.obj AND (pattern = aox OR val = t.val) THEN EXIT; }

ELSE IF LOOPHOLE[att, LONG CARDINAL]<=LOOPHOLE[t.att, LONG CARDINAL] THEN {

aohl ← NIL; EXIT };

ENDLOOP;

axv =>

FOR aohl←IF ~first THEN aohl.first.vLink ELSE aohl, aohl.first.vLink UNTIL aohl = NIL DO

t ← aohl.first.triple;

IF (t.att = att) THEN EXIT;

ENDLOOP;

xov =>

FOR aohl←IF ~first THEN aohl.first.vLink ELSE aohl, aohl.first.vLink UNTIL aohl = NIL DO

t ← aohl.first.triple;

IF (t.obj = obj) THEN EXIT;

ENDLOOP;

axx => IF ~first THEN aohl𡤊ohl.first.aLink;

xox => IF ~first THEN aohl𡤊ohl.first.oLink;

xxv => IF ~first THEN aohl𡤊ohl.first.vLink;

xxx => {

NextIhl: INTERNAL PROC RETURNS [BOOLEAN←FALSE] = {

WHILE (ihl ← ihl.rest)#NIL DO

IF ihl.first.henType=att THEN RETURN[TRUE]; ENDLOOP; };

WHILE aohl=NIL OR (aohl𡤊ohl.first.aLink)=NIL DO

WHILE NOT NextIhl[] DO

IF index=LAST[ItemHashVecIndex] THEN GOTO ReallyDone;

index ← index+1;

ihl ← CONS[[hen: NIL, henType: att], itemHashVec[index]];

ENDLOOP;

aohl ← LIST[[aLink: ihl.first.hen]];

REPEAT

ReallyDone=>NULL;

ENDLOOP; };

ENDCASE => ERROR;

first←FALSE;

IF aohl=NIL THEN RETURN[FALSE];

IF t=NIL THEN t𡤊ohl.first.triple;

IF t=NIL THEN RETURN[FALSE];

nextTriple←t^; };

WHILE (Next[] AND proc[nextTriple]) DO ENDLOOP; };

Select: PUBLIC PROC[att, obj, val: Item] RETURNS[i: Item←NIL] = {

pattern: TripleArgPattern=Pattern[att, obj, val];

SelProc: ForeachProc = {

i ← SELECT pattern FROM aox=>trip.val, axv=>trip.obj, xov=>trip.att, ENDCASE=>ERROR;

RETURN[FALSE]; };

Foreach[att, obj, val, SelProc]; };

Is: PUBLIC PROC[att, obj, val: Item ← Any] RETURNS[ans: BOOLEAN�LSE] = {

IsProc: ForeachProc = { ans←TRUE; RETURN[FALSE]; };

Foreach[att, obj, val, IsProc]; };

SelectCandidate: PUBLIC ENTRY PROC[att: Item, objCandidate: LONG CARDINAL]

RETURNS [ obj, val: Item ] = {

OPEN Basics;

index: AOHashVecIndex = BITAND[BITXOR[Lo[att], LowHalf[objCandidate]],

LAST[AOHashVecIndex]];

aohl: AOHashList ← aoHashVec[index];

UNTIL aohl=NIL DO

t: Triple = aohl.first.triple;

IF att = t.att THEN

IF objCandidate=LOOPHOLE[t.obj, LONG CARDINAL] THEN RETURN [ t.obj, t.val ]

ELSE { aohl ← aohl.rest; LOOP }

ELSE IF LOOPHOLE[att, LONG CARDINAL] > LOOPHOLE[t.att, LONG CARDINAL]

THEN { aohl ← aohl.rest; LOOP }

ELSE EXIT; ENDLOOP;

RETURN[ NIL, NIL ]; };

Dummy1: PROC[a, b, c: Item] = {NULL};

Dummy2: PROC[a: Item] = {NULL};

Erase: PUBLIC PROC[att, obj, val: Item] = {

SELECT Pattern[att, obj, val] FROM

aov => []←SimpleErase[[att, obj, val]];

xxx => Clear[];

ENDCASE => { Foreach[att, obj, val, SimpleErase]; }; };

PRIVATE PROCs

SimpleErase: ENTRY PROC[trip: TripleRec] RETURNS[ continue: BOOLEAN←TRUE] = {

OPEN trip;

ENABLE UNWIND => NULL;

ahl, ohl, vhl: ItemHashList;

aohi: AOHashVecIndex;

aohl, prev: AOHashList←NIL;

IF Pattern[att, obj, val] # aov THEN ERROR;

ahl ← FindALink[att];

ohl ← FindOLink[obj];

vhl ← FindVLink[val];

aohi ← AOHash[att, obj];

aohl ← aoHashVec[aohi];

prev ← NIL;

UNTIL aohl = NIL DO

c: LONG CARDINAL = LOOPHOLE[aohl.first.triple.att];

{

SELECT LOOPHOLE[att, LONG CARDINAL] FROM

=c => IF obj#aohl.first.triple.obj OR val#aohl.first.triple.val THEN GOTO Loop;

<c => EXIT;

ENDCASE-->c-- => GOTO Loop;

EXITS

Loop => { prev𡤊ohl; aohl𡤊ohl.rest; LOOP; }; };

This here's the triple. First, remove it from its AOHashList.

IF prev = NIL THEN aoHashVec[aohi] ← aohl.rest ELSE prev.rest ← aohl.rest;

Now remove it from its item position link lists.

Attribute

prev ← NIL;

aohl ← ahl.first.hen;

UNTIL aohl = NIL DO

IF obj = aohl.first.triple.obj AND val = aohl.first.triple.val THEN {

IF prev = NIL THEN ahl.first.hen ← aohl.first.aLink

ELSE prev.first.aLink ← aohl.first.aLink;

EXIT; }

ELSE {prev ← aohl; aohl ← aohl.first.aLink}; ENDLOOP;

Object

prev ← NIL;

aohl ← ohl.first.hen;

UNTIL aohl = NIL DO

IF att = aohl.first.triple.att AND val = aohl.first.triple.val THEN {

IF prev = NIL THEN ohl.first.hen ← aohl.first.oLink

ELSE prev.first.oLink ← aohl.first.oLink;

EXIT; }

ELSE {prev ← aohl; aohl ← aohl.first.oLink}; ENDLOOP;

Value

prev ← NIL;

aohl ← vhl.first.hen;

UNTIL aohl = NIL DO

IF att = aohl.first.triple.att AND obj = aohl.first.triple.obj THEN {

IF prev = NIL THEN vhl.first.hen ← aohl.first.vLink

ELSE prev.first.vLink ← aohl.first.vLink;

EXIT; }

ELSE { prev ← aohl; aohl ← aohl.first.vLink }; ENDLOOP;

Having erased, quit.

EXIT; ENDLOOP;

IF ahl.first.hen = NIL THEN RemoveEmptyAHen[att, ahl];

IF ohl.first.hen = NIL THEN RemoveEmptyOHen[obj, ohl];

IF vhl.first.hen = NIL THEN RemoveEmptyVHen[val, vhl]; };

Pattern: PROC[att, obj, val: Item] RETURNS[TripleArgPattern] =

{ RETURN[IF att = Any THEN

IF obj = Any THEN

IF val = Any THEN xxx ELSE xxv

ELSE IF val = Any THEN xox ELSE xov

ELSE IF obj = Any THEN

IF val = Any THEN axx ELSE axv

ELSE IF val = Any THEN aox ELSE aov]};

Clear: ENTRY PROC =

{ ENABLE UNWIND => NULL;

FOR i: ItemHashVecIndex IN ItemHashVecIndex DO itemHashVec[i] ← NIL ENDLOOP;

FOR i: AOHashVecIndex IN AOHashVecIndex DO aoHashVec[i] ← NIL ENDLOOP;

};

FindALink: INTERNAL PROC[att: Item] RETURNS[ihl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[att];

ihl ← itemHashVec[ihvi];

UNTIL ihl = NIL DO

IF ihl.first.henType = att AND ihl.first.hen # NIL AND ihl.first.hen.first.triple.att = att THEN

RETURN[ihl]

ELSE ihl ← ihl.rest;

ENDLOOP;

itemHashVec[ihvi] ← ihl ← CONS[[hen: NIL, henType: att], itemHashVec[ihvi]];

};

FindOLink: INTERNAL PROC[obj: Item] RETURNS[ihl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[obj];

ihl ← itemHashVec[ihvi];

UNTIL ihl = NIL DO

IF ihl.first.henType = obj AND ihl.first.hen # NIL AND ihl.first.hen.first.triple.obj = obj THEN

RETURN[ihl]

ELSE ihl ← ihl.rest;

ENDLOOP;

itemHashVec[ihvi] ← ihl ← CONS[[hen: NIL, henType: obj], itemHashVec[ihvi]];

};

FindVLink: INTERNAL PROC[val: Item] RETURNS[ihl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[val];

ihl ← itemHashVec[ihvi];

UNTIL ihl = NIL DO

IF ihl.first.henType = val AND ihl.first.hen # NIL AND ihl.first.hen.first.triple.val = val THEN

RETURN[ihl]

ELSE ihl ← ihl.rest;

ENDLOOP;

itemHashVec[ihvi] ← ihl ← CONS[[hen: NIL, henType: val], itemHashVec[ihvi]];

};

RemoveEmptyAHen: INTERNAL PROC[att: Item, ahl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[att];

ihl: ItemHashList ← itemHashVec[ihvi];

prev: ItemHashList ← NIL;

IF ahl.first.henType # att THEN ERROR;

UNTIL ihl = NIL DO

IF ihl = ahl THEN

{IF prev = NIL THEN itemHashVec[ihvi] ← ihl.rest ELSE prev.rest ← ihl.rest; RETURN}

ELSE {prev ← ihl; ihl ← ihl.rest};

ENDLOOP;

ERROR;

};

RemoveEmptyOHen: INTERNAL PROC[obj: Item, ohl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[obj];

ihl: ItemHashList ← itemHashVec[ihvi];

prev: ItemHashList ← NIL;

IF ohl.first.henType # obj THEN ERROR;

UNTIL ihl = NIL DO

IF ihl = ohl THEN

{IF prev = NIL THEN itemHashVec[ihvi] ← ihl.rest ELSE prev.rest ← ihl.rest; RETURN}

ELSE {prev ← ihl; ihl ← ihl.rest};

ENDLOOP;

ERROR;

};

RemoveEmptyVHen: INTERNAL PROC[val: Item, vhl: ItemHashList] =

{ ihvi: ItemHashVecIndex = ItemHash[val];

ihl: ItemHashList ← itemHashVec[ihvi];

prev: ItemHashList ← NIL;

IF vhl.first.henType # val THEN ERROR;

UNTIL ihl = NIL DO

IF ihl = vhl THEN

{IF prev = NIL THEN itemHashVec[ihvi] ← ihl.rest ELSE prev.rest ← ihl.rest; RETURN}

ELSE {prev ← ihl; ihl ← ihl.rest};

ENDLOOP;

ERROR;

};

AOHash: INTERNAL PROC[att, obj: Item] RETURNS[AOHashVecIndex] =

{OPEN Basics; RETURN[BITAND[BITXOR[Lo[att], Lo[obj]], LAST[AOHashVecIndex]]]};

ItemHash: INTERNAL PROC[item: Item] RETURNS[ItemHashVecIndex] =

{OPEN Basics; RETURN[BITAND[BITXOR[Hi[item], Lo[item]], LAST[ItemHashVecIndex]]]};

Lo: PROC[item: Item] RETURNS [CARDINAL] = TRUSTED INLINE {

RETURN[LOOPHOLE[item, Basics.LongNumber].lo];

};

Hi: PROC[item: Item] RETURNS [CARDINAL] = TRUSTED INLINE {

RETURN[LOOPHOLE[item, Basics.LongNumber].hi];

};

END.