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] ~ {
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] ~ {
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];
};



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.

JTJaMDictImpl.mesa
Copyright c 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.
applies action to each tuple in dict
applies action to dict, then recursively maps its attachments in order

*** JaM INTRINSICS ***
Κx˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ)™)—K™Kšœ3Οkœžœ	™EK˜š
ž	˜	KšœžœN˜ZKš
œ˜Kš
œ˜—K˜KšΠblœžœ
ž˜Kšžœ
˜Kšžœ˜Kšœžœ
žœ˜K˜Kšœžœ
žœ˜5K˜š
Οnœžœ
žœžœžœ
˜5Kš
œ(˜(Kšžœ
žœ$žœ˜5K˜K˜—š
 
œžœ
žœ
žœ
žœ˜4Kšžœ˜K˜K˜—š œžœ
žœžœžœžœžœ˜OKš
œ&˜&K˜K˜—š œžœ
žœžœžœžœ˜=Kšœžœ%˜0Kšžœ
žœžœ˜-K˜K˜—š
 œžœ
žœžœžœ˜5Kš
œ!˜!K˜K˜—š œžœ
žœžœ˜+Kšžœ
žœžœ˜?K˜K˜—š œžœ
žœ˜$Kš
œ!˜!Kšœ;žœžœ˜QKš
œ˜K˜K˜—š
 
œžœ
žœ"žœ
žœ˜JKš
œ$™$š
œ%˜%šžœžœ
ž˜Jšœžœžœ˜&Jšžœžœ
˜—J˜—Jšžœ ˜&K˜K˜—K˜š œžœ!žœ
žœ˜?J™FJšžœžœ
žœ
žœ˜"šžœžœ
žœžœžœ
ž˜AKšžœžœ
žœ
žœ˜1Kšžœ
˜—Kšžœ
žœ˜K˜K˜—š 
œžœ
žœ˜/Kšœžœ˜+Kšœžœ˜+Kšžœžœ˜<Kšžœžœ
žœΟc˜9Kšœžœ˜)K˜K˜—š 
œžœ
žœ˜/Kšœžœ
žœžœ
˜šžœ žœžœ
ž˜4Kšžœžœ
žœ
žœ
˜/Kšžœ
˜—Kšžœžœ
žœ‘˜=Kšžœžœ
žœžœ˜EK˜K˜—š 	œžœ
žœ˜&Kšœžœ
˜K˜K˜—š
 œžœ
žœ!žœ
žœ˜Mšžœžœ
žœžœžœ
ž˜AKšžœžœ
žœ
žœ˜(Kšžœ
˜—Jšžœ
žœ˜K˜K˜—K˜š
 œžœ
žœžœžœ˜;Kšžœ
žœ2˜<K˜K˜—š œžœ
žœžœ
˜4K˜K˜"Kšžœ
žœžœ#˜<Kšžœ˜K˜K˜—š œžœ
žœ˜0K˜K˜"Kšžœ
žœžœ"˜DKš
œ˜Kš
œ˜Kšžœžœ˜6K˜K˜—š œžœ
žœ˜"K˜K˜"Kšžœ
žœžœ#˜<Kš
œ˜Kšœžœ
˜K˜K˜—š
 œžœ
žœ#žœ
žœ˜PK˜K˜"š	žœžœ
ž
œ
žœž˜+K˜Kšžœžœ
žœ
žœ˜"Kšžœ
˜—Kšžœ
žœ˜K˜K˜—š œžœ#žœ
žœ˜FK˜K˜"š	žœžœ
ž
œ
žœž˜+Kšžœžœ
žœ
žœ˜/Kšžœ
˜—Kšžœ
žœ˜K˜K˜—K˜š œžœžœžœžœžœ˜SKšœFžœ
˜VKšžœ
žœžœ
žœ
žœžœžœ˜>K˜K˜—š œžœ
žœžœžœžœ˜QKšœžœ
˜	Kš
œ:˜:Kšžœžœ‘˜=K˜K˜—š 	œžœ
žœžœžœžœžœ˜RKš
œ$˜$Kšžœžœ
žœ
˜Kš
œ,˜,Kšžœ
žœžœ*˜;Kšžœžœ˜(K˜K˜—š œžœ
žœžœžœžœ˜@Kšœžœ'˜2Kšžœ
žœžœ˜-K˜K˜—š
 œžœ
žœžœžœ˜7Kš
œ˜K˜Kš
œ˜K˜K˜—š
 œžœ
žœžœžœ˜9Kšœžœ"˜>Kšžœžœ˜<Kšžœ˜K˜K˜—K™š œžœžœžœžœžœ˜JKšžœ
žœžœ˜K˜K˜—š œžœžœžœ˜5K˜K˜—š œžœžœ˜+K˜K˜—š 
œžœ˜"K˜K˜—K˜˜K˜—š œžœ
žœžœ˜AKšœžœ˜Kšœžœ#˜1K˜K˜K˜—K˜Kš
œ™K˜š œžœžœ
žœ˜,Kšœžœ˜šžœžœ
ž˜Kšœžœžœ˜Kšœžœžœ˜#Kšžœ˜#—Kšžœ
žœ˜K˜—K˜š 	œžœ
žœ˜(Kšœžœ˜K˜!K˜K˜—š œžœ
žœ˜'Kšœžœ˜K˜K˜K˜K˜—š œžœ
žœ˜'Kšœžœ˜Kšœžœ˜K˜K˜Kšœ‘˜1K˜K˜—š œžœ
žœ˜'Kšœžœ˜K˜K˜Kšœ‘˜1K˜K˜—š œžœ
žœ˜+K˜K˜Kšœ‘˜.K˜K˜—š œžœ
žœ˜.Kšœžœ˜K˜š
œ˜K˜K˜Kšœ$žœžœ˜6K˜—Kš
œ˜K˜K˜—š œžœ
žœ˜.K˜K˜K˜Kšœ‘˜.K˜K˜—š œžœ
žœ˜.K˜K˜K˜K˜K˜—š œžœ
žœ˜-K˜K˜K˜K˜—š œžœ
žœ˜2Kšœžœ˜K˜˜K˜Kšœ$žœžœ˜6K˜—K˜"K˜K˜—š 
œžœ
žœ˜)Kšœžœ˜K˜K˜+K˜K˜—š 
œžœ
žœ˜)Kšœžœ˜Kšœžœ˜K˜#Kšžœžœ˜%K˜K˜K˜—š 	œžœ
žœ˜(Kšœžœ˜K˜K˜K˜—š œžœ
žœ˜'Kšœžœ˜Kšœžœ˜K˜K˜K˜—š 
œžœ
žœ˜)Kšœžœ˜Kšœžœ˜K˜K˜K˜—š 
œžœ
žœ˜)K˜K˜K˜K˜—š œžœ
žœ˜'K˜K˜K˜—š œžœ
žœ˜+K˜ K˜K˜—K˜K˜&K˜$K˜$K˜$K˜,K˜(K˜(K˜$K˜&K˜(K˜(K˜$K˜2K˜,K˜2K˜2K˜:K˜0K˜Kšžœ
˜—…—$1Ϊ