TJaMDictImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, March 25, 1985 4:44:03 pm PST
Administers JaM dictionaries. A Dict is a set of <ATOM, REF> tuples.
DIRECTORY
RefTab USING [Create, Delete, EachPairAction, Fetch, GetSize, Pairs, Ref, Replace, Store],
TJaM,
TJaMPrivate;
TJaMDictImpl: CEDAR PROGRAM
IMPORTS RefTab, TJaM
EXPORTS TJaM, TJaMPrivate
~ BEGIN OPEN TJaM, TJaMPrivate;
FrameImplRep: PUBLIC TYPE ~ TJaMPrivate.FrameImplRep;
NewDict:
PUBLIC
PROC[mod:
NAT ← 17]
RETURNS[Dict] ~ {
refTab: RefTab.Ref ~ RefTab.Create[mod];
RETURN[NEW[DictRep ← [refTab: refTab, attach: NIL]]];
};
DictLength:
PUBLIC
PROC[dict: Dict]
RETURNS[
INT] ~ {
RETURN[dict.refTab.GetSize[]];
};
TryToGet:
PUBLIC
PROC[dict: Dict, key:
ATOM]
RETURNS[found:
BOOL, val:
REF] ~ {
[found, val] ← dict.refTab.Fetch[key];
};
Get:
PUBLIC
PROC[dict: Dict, key:
ATOM]
RETURNS[val:
REF] ~ {
found: BOOL; [found, val] ← TryToGet[dict, key];
IF NOT found THEN ProduceError[undefinedKey];
};
Put:
PUBLIC
PROC[dict: Dict, key:
ATOM, val:
REF] ~ {
[] ← dict.refTab.Store[key, val];
};
Del:
PUBLIC
PROC[dict: Dict, key:
ATOM] ~ {
IF NOT dict.refTab.Delete[key] THEN ProduceError[undefinedKey];
};
ClrDict:
PUBLIC
PROC[dict: Dict] ~ {
refTab: RefTab.Ref ~ dict.refTab;
delete: RefTab.EachPairAction ~ { [] ← refTab.Delete[key]; RETURN[quit: FALSE] };
[] ← refTab.Pairs[delete];
};
DictForAll:
PUBLIC
PROC[dict: Dict, action: TupleAction]
RETURNS[
BOOL] ~ {
applies action to each tuple in dict
pairAction: RefTab.EachPairAction ~ {
WITH key
SELECT
FROM
key: ATOM => RETURN[action[key, val]];
ENDCASE => ERROR;
};
RETURN[dict.refTab.Pairs[pairAction]];
};
DictMap:
PROC[dict: Dict, action: DictAction]
RETURNS[
BOOL] ~ {
applies action to dict, then recursively maps its attachments in order
IF action[dict] THEN RETURN[TRUE];
FOR list:
LIST
OF Dict ← dict.attach, list.rest
UNTIL list=
NIL
DO
IF DictMap[list.first, action] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
AttachDict:
PUBLIC
PROC[dict1, dict2: Dict] ~ {
find1: DictAction ~ { RETURN[dict=dict1] };
find2: DictAction ~ { RETURN[dict=dict2] };
IF DictMap[dict2, find1] THEN ProduceError[attachmentCycle];
IF DictMap[dict1, find2] THEN RETURN; -- already attached
dict1.attach ← CONS[dict2, dict1.attach];
};
DetachDict:
PUBLIC
PROC[dict1, dict2: Dict] ~ {
list, prev: LIST OF Dict ← NIL;
FOR list ← dict1.attach, list.rest
UNTIL list=
NIL
DO
IF list.first=dict2 THEN EXIT ELSE prev ← list;
ENDLOOP;
IF list=NIL THEN ProduceError[notAttached]; -- didn't find it
IF prev=NIL THEN dict1.attach ← list.rest ELSE prev.rest ← list.rest;
};
DetachAll:
PUBLIC
PROC[dict: Dict] ~ {
dict.attach ← NIL;
};
AttachedForAll:
PUBLIC
PROC[dict: Dict, action: DictAction]
RETURNS[
BOOL] ~ {
FOR list:
LIST
OF Dict ← dict.attach, list.rest
UNTIL list=
NIL
DO
IF action[list.first] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
NewDictStack:
PUBLIC
PROC[size:
NAT]
RETURNS[DictStack] ~ {
RETURN[NEW[DictStackRep[size] ← [count: 0, max: 0, seq: ]]];
};
DictTop:
PUBLIC
PROC[frame: Frame]
RETURNS[Dict] ~ {
impl: FrameImpl ~ frame.impl;
stack: DictStack ~ impl.dictStack;
IF NOT stack.count>0 THEN ProduceError[dictionaryUnderflow];
RETURN[stack[stack.count-1]];
};
Begin:
PUBLIC
PROC[frame: Frame, dict: Dict] ~ {
impl: FrameImpl ~ frame.impl;
stack: DictStack ~ impl.dictStack;
IF NOT stack.count<stack.size THEN ProduceError[dictionaryOverflow];
stack[stack.count] ← dict;
stack.count ← stack.count+1;
IF stack.count>stack.max THEN stack.max ← stack.count;
};
End:
PUBLIC
PROC[frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: DictStack ~ impl.dictStack;
IF NOT stack.count>0 THEN ProduceError[dictionaryUnderflow];
stack.count ← stack.count-1;
stack[stack.count] ← NIL;
};
DictStackForAll:
PUBLIC
PROC[frame: Frame, action: DictAction]
RETURNS[
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
stack: DictStack ~ impl.dictStack;
FOR i:
NAT
DECREASING
IN[0..stack.count)
DO
dict: Dict ~ stack[i];
IF action[dict] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
DictStackMap:
PROC[frame: Frame, action: DictAction]
RETURNS[
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
stack: DictStack ~ impl.dictStack;
FOR i:
NAT
DECREASING
IN[0..stack.count)
DO
IF DictMap[stack[i], action] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
Find:
PROC[frame: Frame, key:
ATOM]
RETURNS[found:
BOOL, val:
REF, where: Dict] ~ {
find: DictAction ~ { [found, val] ← (where ← dict).refTab.Fetch[key]; RETURN[found] };
IF NOT DictStackMap[frame, find] THEN RETURN[FALSE, NIL, NIL];
};
Where:
PUBLIC
PROC[frame: Frame, key:
ATOM]
RETURNS[found:
BOOL, where: Dict] ~ {
val: REF;
[found: found, val: val, where: where] ← Find[frame, key];
IF found THEN CachePut[frame, key, val]; -- anticipate a Load
};
TryToLoad:
PUBLIC
PROC[frame: Frame, key:
ATOM]
RETURNS[found:
BOOL, val:
REF] ~ {
[found, val] ← CacheGet[frame, key];
IF found THEN RETURN;
[found: found, val: val] ← Find[frame, key];
IF NOT found THEN [found, val] ← TryToGet[primitives, key];
IF found THEN CachePut[frame, key, val];
};
Load:
PUBLIC
PROC[frame: Frame, key:
ATOM]
RETURNS[val:
REF] ~ {
found: BOOL; [found, val] ← TryToLoad[frame, key];
IF NOT found THEN ProduceError[undefinedKey];
};
Def:
PUBLIC
PROC[frame: Frame, key:
ATOM, val:
REF] ~ {
dict: Dict ~ DictTop[frame];
Put[dict, key, val];
CachePut[frame, key, val];
};
Store:
PUBLIC
PROC[frame: Frame, key:
ATOM, val:
REF] ~ {
store: DictAction ~ { RETURN[dict.refTab.Replace[key, val]] };
IF DictStackMap[frame, store] THEN CachePut[frame, key, val]
ELSE Def[frame, key, val];
};
CacheGet:
PROC[frame: Frame, key:
ATOM]
RETURNS[found:
BOOL, val:
REF] ~ {
RETURN[FALSE, NIL];
};
CachePut:
PROC[frame: Frame, key:
ATOM, val:
REF] ~ {
};
CacheDel:
PROC[frame: Frame, key:
ATOM] ~ {
};
CacheClear:
PROC[frame: Frame] ~ {
};
primitives: Dict ~ NewDict[97];
RegisterPrimitive:
PUBLIC
PROC[name:
ROPE, proc: CommandProc] ~ {
key: ATOM ~ AtomFromRope[name];
cmd: Cmd ~ NEW[CmdRep ← [proc: proc, name: key]];
Put[primitives, key, cmd];
};
*** JaM INTRINSICS ***
PopKey:
PROC[frame: Frame]
RETURNS[
ATOM] ~ {
x: REF ~ Pop[frame];
WITH x
SELECT
FROM
x: ATOM => RETURN[x];
x: ROPE => RETURN[AtomFromRope[x]];
ENDCASE => ProduceError[wrongType];
RETURN[NIL];
};
ApplyDict:
PUBLIC
PROC[frame: Frame] ~ {
length: INT ~ PopInt[frame];
PushDict[frame, NewDict[length]];
};
ApplyGet:
PUBLIC
PROC[frame: Frame] ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
Push[frame, Get[dict, key]];
};
ApplyPut:
PUBLIC
PROC[frame: Frame] ~ {
val: REF ~ Pop[frame];
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
Put[dict, key, val];
CacheDel[frame, key]; -- in case dict is on stack
};
ApplyDel:
PUBLIC
PROC[frame: Frame] ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
Del[dict, key];
CacheDel[frame, key]; -- in case dict is on stack
};
ApplyClrDict:
PUBLIC
PROC[frame: Frame] ~ {
dict: Dict ~ PopDict[frame];
ClrDict[dict];
CacheClear[frame]; -- in case dict is on stack
};
ApplyDictForAll:
PUBLIC
PROC[frame: Frame] ~ {
x: REF ~ Pop[frame];
dict: Dict ~ PopDict[frame];
action: TupleAction ~ {
PushAtom[frame, key];
Push[frame, val];
Execute[frame, x ! Exit => { quit ← TRUE; CONTINUE }];
};
[] ← DictForAll[dict, action];
};
ApplyAttachDict:
PUBLIC
PROC[frame: Frame] ~ {
dict2: Dict ~ PopDict[frame];
dict1: Dict ~ PopDict[frame];
AttachDict[dict1, dict2];
CacheClear[frame]; -- in case dict is on stack
};
ApplyDetachDict:
PUBLIC
PROC[frame: Frame] ~ {
dict2: Dict ~ PopDict[frame];
dict1: Dict ~ PopDict[frame];
DetachDict[dict1, dict2];
};
ApplyDetachAll:
PUBLIC
PROC[frame: Frame] ~ {
dict: Dict ~ PopDict[frame];
DetachAll[dict];
};
ApplyAttachedForAll:
PUBLIC
PROC[frame: Frame] ~ {
x: REF ~ Pop[frame];
dict: Dict ~ PopDict[frame];
action: DictAction ~ {
PushDict[frame, dict];
Execute[frame, x ! Exit => { quit ← TRUE; CONTINUE }];
};
[] ← AttachedForAll[dict, action];
};
ApplyKnown:
PUBLIC
PROC[frame: Frame] ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
PushBool[frame, TryToGet[dict, key].found];
};
ApplyWhere:
PUBLIC
PROC[frame: Frame] ~ {
key: ATOM ~ PopKey[frame];
found: BOOL; where: Dict;
[found, where] ← Where[frame, key];
IF found THEN PushDict[frame, where];
PushBool[frame, found];
};
ApplyLoad:
PUBLIC
PROC[frame: Frame] ~ {
key: ATOM ~ PopKey[frame];
Push[frame, Load[frame, key]];
};
ApplyDef:
PUBLIC
PROC[frame: Frame] ~ {
val: REF ~ Pop[frame];
key: ATOM ~ PopKey[frame];
Def[frame, key, val];
};
ApplyStore:
PUBLIC
PROC[frame: Frame] ~ {
val: REF ~ Pop[frame];
key: ATOM ~ PopKey[frame];
Store[frame, key, val];
};
ApplyBegin:
PUBLIC
PROC[frame: Frame] ~ {
dict: Dict ~ PopDict[frame];
Begin[frame, dict];
};
ApplyEnd:
PUBLIC
PROC[frame: Frame] ~ {
End[frame];
};
ApplyCurDict:
PUBLIC
PROC[frame: Frame] ~ {
PushDict[frame, DictTop[frame]];
};
RegisterPrimitive[".dict", ApplyDict];
RegisterPrimitive[".get", ApplyGet];
RegisterPrimitive[".put", ApplyPut];
RegisterPrimitive[".del", ApplyDel];
RegisterPrimitive[".clrdict", ApplyClrDict];
RegisterPrimitive[".known", ApplyKnown];
RegisterPrimitive[".where", ApplyWhere];
RegisterPrimitive[".def", ApplyDef];
RegisterPrimitive[".load", ApplyLoad];
RegisterPrimitive[".store", ApplyStore];
RegisterPrimitive[".begin", ApplyBegin];
RegisterPrimitive[".end", ApplyEnd];
RegisterPrimitive[".dictforall", ApplyDictForAll];
RegisterPrimitive[".curdict", ApplyCurDict];
RegisterPrimitive[".attachdict", ApplyAttachDict];
RegisterPrimitive[".detachdict", ApplyDetachDict];
RegisterPrimitive[".attachedforall", ApplyAttachedForAll];
RegisterPrimitive[".detachall", ApplyDetachAll];
END.