TJaMDictImpl.mesa
Copyright Ó 1985, 1986, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Michael Plass, September 24, 1991 12:03 pm PDT
Doug Wyatt, October 19, 1993 12:56 pm PDT
Administers JaM dictionaries. A Dict is a set of <ATOM, REF> tuples.
DIRECTORY
Atom USING [GetPName, MakeAtom],
RefTab USING [Create, Delete, EachPairAction, Fetch, GetSize, Pairs, Ref, Replace, Store],
TJaM,
TJaMPrivate;
TJaMDictImpl: CEDAR PROGRAM
IMPORTS Atom, RefTab, TJaM
EXPORTS TJaM, TJaMPrivate
~ BEGIN OPEN TJaM, TJaMPrivate;
RopeFromAtom:
PUBLIC
PROC [atom:
ATOM]
RETURNS [
ROPE] ~ {
RETURN[Atom.GetPName[atom]];
};
AtomFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [
ATOM] ~ {
RETURN[Atom.MakeAtom[rope]];
};
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] ~ {
stack: DictStack ~ NEW[DictStackRep[size]];
stack.count ¬ stack.max ¬ 0;
RETURN[stack];
};
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 ¬
TRUE, 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, data:
REF ¬
NIL] ~ {
key: ATOM ~ AtomFromRope[name];
cmd: Cmd ~ NEW[CmdRep ¬ [proc: proc, data: data, 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: CommandProc ~ {
length: INT ~ PopInt[frame];
PushDict[frame, NewDict[length]];
};
ApplyGet: CommandProc ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
Push[frame, Get[dict, key]];
};
ApplyPut: CommandProc ~ {
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: CommandProc ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
Del[dict, key];
CacheDel[frame, key]; -- in case dict is on stack
};
ApplyClrDict: CommandProc ~ {
dict: Dict ~ PopDict[frame];
ClrDict[dict];
CacheClear[frame]; -- in case dict is on stack
};
ApplyDictForAll: CommandProc ~ {
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: CommandProc ~ {
dict2: Dict ~ PopDict[frame];
dict1: Dict ~ PopDict[frame];
AttachDict[dict1, dict2];
CacheClear[frame]; -- in case dict is on stack
};
ApplyDetachDict: CommandProc ~ {
dict2: Dict ~ PopDict[frame];
dict1: Dict ~ PopDict[frame];
DetachDict[dict1, dict2];
};
ApplyDetachAll: CommandProc ~ {
dict: Dict ~ PopDict[frame];
DetachAll[dict];
};
ApplyAttachedForAll: CommandProc ~ {
x: REF ~ Pop[frame];
dict: Dict ~ PopDict[frame];
action: DictAction ~ {
PushDict[frame, dict];
Execute[frame, x ! Exit => { quit ¬ TRUE; CONTINUE }];
};
[] ¬ AttachedForAll[dict, action];
};
ApplyKnown: CommandProc ~ {
key: ATOM ~ PopKey[frame];
dict: Dict ~ PopDict[frame];
PushBool[frame, TryToGet[dict, key].found];
};
ApplyWhere: CommandProc ~ {
key: ATOM ~ PopKey[frame];
found: BOOL; where: Dict;
[found, where] ¬ Where[frame, key];
IF found THEN PushDict[frame, where];
PushBool[frame, found];
};
ApplyLoad: CommandProc ~ {
key: ATOM ~ PopKey[frame];
Push[frame, Load[frame, key]];
};
ApplyDef: CommandProc ~ {
val: REF ~ Pop[frame];
key: ATOM ~ PopKey[frame];
Def[frame, key, val];
};
ApplyStore: CommandProc ~ {
val: REF ~ Pop[frame];
key: ATOM ~ PopKey[frame];
Store[frame, key, val];
};
ApplyBegin: CommandProc ~ {
dict: Dict ~ PopDict[frame];
Begin[frame, dict];
};
ApplyEnd: CommandProc ~ {
End[frame];
};
ApplyCurDict: CommandProc ~ {
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.