PipalOpsImpl.mesa 
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
Bertrand Serlet July 3, 1988 2:15:01 pm PDT
Louis Monier January 20, 1988 2:51:13 am PST
Barth, January 29, 1988 6:23:15 pm PST
DIRECTORY
Basics, IO,
Pipal, PipalInt, PipalOps, PipalReal,
ProcessProps, RefTab, TerminalIO;
PipalOpsImpl: CEDAR MONITOR
IMPORTS Basics, IO, Pipal, PipalInt, PipalReal, ProcessProps, RefTab, TerminalIO
EXPORTS PipalOps =
BEGIN OPEN PipalOps;
Enumeration
enumerateMethod: PUBLIC Pipal.Method ← Pipal.RegisterMethod["SimpleEnumerate"];
HasEnumerate: PUBLIC PROC [object: Pipal.Object] RETURNS [BOOL] = {
RETURN [Pipal.ObjectMethod[object, enumerateMethod]#NIL OR PipalReal.HasEnumerate[object]];
};
Enumerate: PUBLIC EnumerateProc = {
data: REF ← Pipal.ObjectMethod[object, enumerateMethod];
quit ← (IF data=NIL THEN IF PipalInt.HasEnumerate[object] THEN UseIntEnumerate ELSE UseRealEnumerate ELSE NARROW [data, REF EnumerateProc]^)[object, each];
};
UseIntEnumerate: EnumerateProc = {
EachChild: PipalInt.EachChildProc = {
quit ← each[child];
};
quit ← PipalInt.Enumerate[object, EachChild];
};
UseRealEnumerate: EnumerateProc = {
EachChild: PipalReal.EachChildProc = {
quit ← each[child];
};
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
quit ← PipalReal.Enumerate[object, EachChild, transformation];
PipalReal.DestroyTransformation[transformation];
};
CountChildren: PUBLIC PROC [object: Pipal.Object] RETURNS [count: NAT ← 0] = {
EachChild: EachChildProc = {count ← count + 1};
[] ← Enumerate[object, EachChild];
};
NthChild: PUBLIC PROC [object: Pipal.Object, rank: NAT ← 0] RETURNS [nthChild: Pipal.Object ← NIL] = {
EachChild: EachChildProc = {
IF rank=0 THEN {nthChild ← child; quit ← TRUE} ELSE rank ← rank - 1;
};
[] ← Enumerate[object, EachChild];
};
Recast: PUBLIC PROC [object: Pipal.Object] RETURNS [Pipal.Object] = {
children: Pipal.Objects ← NIL;
IF PipalInt.HasEnumerate[object] THEN {
EachChild: PipalInt.EachChildProc = {
children ← CONS [PipalInt.TransformObject[transformation, child], children];
};
[] ← PipalInt.Enumerate[object, EachChild];
} ELSE {
EachChild: PipalReal.EachChildProc = {
children ← CONS [PipalReal.TransformObject[transformation, child], children];
};
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
[] ← PipalReal.Enumerate[object, EachChild, transformation];
PipalReal.DestroyTransformation[transformation];
};
RETURN [IF children#NIL AND children.rest=NIL THEN children.first ELSE Pipal.CreateOverlay[children]]; -- optimization for when only one child
};
HashByEnumeration: PUBLIC Pipal.HashProc = {
Each: EachChildProc = {hash ← hash + Pipal.Hash[child] + 1};
hash ← Pipal.HashObjectClass[object];
[] ← Enumerate[object, Each];
};
hashCache: Pipal.ObjectCache ← Pipal.CreateObjectCache[];
CachedHashByEnumeration: PUBLIC Pipal.HashProc = {
refHash: REF CARD ← NARROW [RefTab.Fetch[hashCache, object].val];
IF refHash#NIL THEN RETURN [refHash^];
hash ← HashByEnumeration[object];
[] ← RefTab.Store[hashCache, object, NEW [CARD ← hash]];
};
EqualByEnumeration: PUBLIC Pipal.EqualProc = {
size: NAT ← CountChildren[object1];
IF CountChildren[object2]#size THEN RETURN [FALSE];
FOR i: NAT IN [0 .. size) DO
IF NOT Pipal.Equal[NthChild[object1], NthChild[object2]] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
Enumeration Speed Up (Speed Up Only!)
EnumerateOverlay: EnumerateProc ~ {
overlay: Pipal.Overlay ← NARROW [object];
FOR i: NAT IN [0 .. overlay.size) DO
IF each[overlay[i]] THEN RETURN [TRUE];
ENDLOOP;
};
EnumerateAnnotation: EnumerateProc ~ {
annotation: Pipal.Annotation ← NARROW [object];
quit ← each[annotation.child];
};
EnumerateTransform: EnumerateProc = {
transform: PipalInt.Transform ← NARROW [object];
quit ← each[transform.child];
};
EnumerateTranslation: EnumerateProc = {
translation: PipalInt.Translation ← NARROW [object];
quit ← each[translation.child];
};
Transitive Closure
hashSetFlag: BOOL ← FALSE;
hashSetCache: Pipal.ObjectCache ← Pipal.CreateObjectCache[];
LeafHashSet: PROC [obj: Pipal.Object] RETURNS [hs: Basics.LongNumber ← [li[li: 0]]] = {
hash: CARD ← (Pipal.Hash[obj]/2) MOD 31;
hs.bits[hash] ← TRUE;
};
HashSet: PROC [obj: Pipal.Object] RETURNS [hs: Basics.LongNumber ← [li[li: 0]]] = {
IF NOT HasEnumerate[obj]
THEN TRUSTED {hs ← LeafHashSet[obj]}
ELSE {
IsChildAncestor: EachChildProc = TRUSTED {hs ← Basics.DoubleOr[hs, HashSet[child]]};
ref: REF Basics.LongNumber ← NARROW [RefTab.Fetch[hashSetCache, obj].val];
IF ref#NIL THEN RETURN [ref^];
[] ← Enumerate[obj, IsChildAncestor];
[] ← RefTab.Store[hashSetCache, obj, NEW [Basics.LongNumber ← hs]];
};
};
reachabilityCache: Pipal.ObjectCache ← Pipal.CreateObjectCache[];
Maps candidates to RefTabs mapping roots to $True or $False, but only when roots have 2 or more children.
Reachable: PUBLIC PROC [root, candidate: Pipal.Object] RETURNS [reached: BOOL] = {
SELECT TRUE FROM
root=candidate    => RETURN [TRUE];
NOT HasEnumerate[root] => RETURN [FALSE];
hashSetFlag AND Basics.DoubleAnd[LeafHashSet[candidate], HashSet[root]]#LeafHashSet[candidate] => RETURN [FALSE];
ENDCASE     => {
count: NAT ← 0;
IsChildAncestor: EachChildProc = {quit ← Reachable[child, candidate]};
FastCount: EachChildProc = {count ← count+1; IF count>1 THEN quit ← TRUE};
SELECT TRUE FROM
Enumerate[root, FastCount] => {
many children
rootCache: RefTab.Ref ← NARROW [RefTab.Fetch[reachabilityCache, candidate].val];
IF rootCache=NIL THEN {
rootCache ← RefTab.Create[mod: 3];
[] ← RefTab.Store[reachabilityCache, candidate, rootCache];
};
IF RefTab.Fetch[rootCache, root].found THEN RETURN [RefTab.Fetch[rootCache, root].val=$True];
reached ← Enumerate[root, IsChildAncestor];
[] ← RefTab.Store[rootCache, root, IF reached THEN $True ELSE $False];
};
count=1 => RETURN [Enumerate[root, IsChildAncestor]];
count=0 => RETURN [FALSE];
ENDCASE => ERROR;
};
};
AnyReachable: PUBLIC PROC [root: Pipal.Object, table: RefTab.Ref] RETURNS [BOOL] = {
EachOldNew: RefTab.EachPairAction = {quit ← Reachable[root, key]};
RETURN [RefTab.Pairs[table, EachOldNew]];
};
Replacement
replaceMethod: PUBLIC Pipal.Method ← Pipal.RegisterMethod["Replace"];
Replace: PUBLIC ReplaceProc = {
newParent ← (NARROW [Pipal.ObjectMethod[parent, replaceMethod], REF ReplaceProc]^)[parent, map];
};
ReplaceWithTable: PUBLIC PROC [oldRoot: Pipal.Object, table: ReplaceTable] = {
Map: MapProc = {
new ← RefTab.Fetch[table, old].val;
IF new=NIL THEN new ← old;
};
newRoot: Pipal.Object ← Replace[oldRoot, Map];
IF newRoot#oldRoot THEN [] ← RefTab.Store[table, oldRoot, newRoot];
};
ReplaceFromRecast: PUBLIC ReplaceProc = {
newParent ← Replace[Recast[parent], map];
};
PrimitiveTable: PROC [table: ReplaceTable] RETURNS [primitive: ReplaceTable] = {
FillPrimitive: RefTab.EachPairAction = {
candidate: Pipal.Object ← key;
IsAncesterOfSome: RefTab.EachPairAction = {
quit ← candidate#key AND Reachable[candidate, key];
};
IF NOT RefTab.Pairs[table, IsAncesterOfSome]
THEN [] ← RefTab.Store[primitive, candidate, val];
};
primitive ← RefTab.Create[];
[] ← RefTab.Pairs[table, FillPrimitive];
};
simpleReplace: BOOL ← TRUE;
SimpleTransitiveReplace: PUBLIC PROC [root: Pipal.Object, table: ReplaceTable] = {
ReplaceChildRecursive: EachChildProc = {
TransitiveReplace[child, table];
};
IF RefTab.Fetch[table, root].val#NIL THEN RETURN;
IF NOT AnyReachable[root, table] THEN RETURN;
[] ← Enumerate[root, ReplaceChildRecursive];
ReplaceWithTable[root, table];
};
TransitiveReplace: PUBLIC PROC [root: Pipal.Object, table: ReplaceTable] = {
IF simpleReplace
THEN SimpleTransitiveReplace[root, table]
ELSE FancyTransitiveReplace[root, table, PrimitiveTable[table]]
};
FancyTransitiveReplace: PUBLIC PROC [root: Pipal.Object, table, primitive: ReplaceTable] = {
ReplaceChildRecursive: EachChildProc = {
FancyTransitiveReplace[child, table, primitive];
};
IF RefTab.Fetch[table, root].val#NIL THEN RETURN;
IF NOT AnyReachable[root, primitive] THEN RETURN;
[] ← Enumerate[root, ReplaceChildRecursive];
ReplaceWithTable[root, table];
};
Path
ConcatPath: PUBLIC PROC [rootPath, childPath: Path] RETURNS [newPath: Path] = {
IF rootPath=NIL THEN RETURN [childPath];
newPath ← CONS [rootPath.first, ConcatPath[rootPath.rest, childPath]];
};
ExtendPath: PUBLIC PROC [currentPath: Path, type: PathBitType, rank: NAT] RETURNS [newPath: Path] = {
newPath ← ConcatPath[currentPath, LIST [[type, rank]]];
};
ApplyPathBit: PUBLIC PROC [root: Pipal.Object, pathBit: PathBit] RETURNS [child: Pipal.Object] = {
SELECT pathBit.type FROM
ops => child ← NthChild[root, pathBit.rank];
real => child ← PipalReal.NthChild[root, PipalReal.CreateTransformation[], pathBit.rank].nthChild;
int => child ← PipalInt.NthChild[root, [], pathBit.rank].nthChild;
ENDCASE => ERROR;
};
ApplyPath: PUBLIC PROC [root: Pipal.Object, path: Path] RETURNS [child: Pipal.Object] = {
child ← root;
WHILE path#NIL DO
child ← ApplyPathBit[child, path.first];
path ← path.rest;
ENDLOOP;
};
ApplyRealPath: PUBLIC PROC [root: Pipal.Object, path: Path, transformation: PipalReal.Transformation] RETURNS [trans: PipalReal.Transformation, child: Pipal.Object] = {
trans ← transformation; child ← root;
WHILE path#NIL DO
IF path.first.type#real THEN ERROR;
[trans, child] ← PipalReal.NthChild[child, trans, path.first.rank];
path ← path.rest;
ENDLOOP;
};
ApplyIntPath: PUBLIC PROC [root: Pipal.Object, path: Path, transformation: PipalInt.Transformation] RETURNS [trans: PipalInt.Transformation, child: Pipal.Object] = {
trans ← transformation; child ← root;
WHILE path#NIL DO
IF path.first.type#real THEN ERROR;
[trans, child] ← PipalInt.NthChild[child, trans, path.first.rank];
path ← path.rest;
ENDLOOP;
};
ReplaceInPathWithTable: PUBLIC PROC [root: Pipal.Object, path: Path, table: ReplaceTable] = {
IF path=NIL THEN RETURN;
ReplaceInPathWithTable[ApplyPathBit[root, path.first], path.rest, table];
ReplaceWithTable[root, table];
};
ReplaceInPath: PUBLIC PROC [root: Pipal.Object, path: Path, oldChild, newChild: Pipal.Object] RETURNS [table: ReplaceTable] = {
table ← RefTab.Create[];
[] ← RefTab.Store[table, oldChild, newChild];
ReplaceInPathWithTable[root, path, table];
};
FindOpsPath: PUBLIC PROC [root, searched: Pipal.Object] RETURNS [path: Path, found: BOOL] = {
count: NAT ← 0;
Each: EachChildProc = {
[path, found] ← FindOpsPath[child, searched];
IF found THEN {
quit ← TRUE;
path ← ConcatPath[ExtendPath[NIL, ops, count], path];
};
count ← count + 1;
};
IF NOT Reachable[root, searched] THEN RETURN [NIL, FALSE];
IF root=searched THEN RETURN [NIL, TRUE];
found ← Enumerate[root, Each];
};
FindRealPath: PUBLIC PROC [rootTrans: PipalReal.Transformation, root: Pipal.Object, searchedTrans: PipalReal.Transformation, searched: Pipal.Object] RETURNS [path: Path, found: BOOL] = {
count: NAT ← 0;
Each: PipalReal.EachChildProc = {
[path, found] ← FindRealPath[transformation, child, searchedTrans, searched];
IF found THEN {
quit ← TRUE;
path ← ConcatPath[ExtendPath[NIL, real, count], path];
};
count ← count + 1;
};
IF NOT Reachable[root, searched] THEN RETURN [NIL, FALSE];
IF root=searched THEN RETURN [path, PipalReal.EqualTransformation[rootTrans, searchedTrans]];
found ← PipalReal.Enumerate[root, Each, rootTrans];
};
FindIntPath: PUBLIC PROC [rootTrans: PipalInt.Transformation, root: Pipal.Object, searchedTrans: PipalInt.Transformation, searched: Pipal.Object] RETURNS [path: Path, found: BOOL] = {
count: NAT ← 0;
Each: PipalInt.EachChildProc = {
[path, found] ← FindIntPath[transformation, child, searchedTrans, searched];
IF found THEN {
quit ← TRUE;
path ← ConcatPath[ExtendPath[NIL, int, count], path];
};
count ← count + 1;
};
IF NOT Reachable[root, searched] THEN RETURN [NIL, FALSE];
IF root=searched THEN RETURN [NIL, rootTrans=searchedTrans];
found ← PipalInt.Enumerate[root, Each, rootTrans];
};
Events and Notification
DogData: TYPE = RECORD [dog: WatchDog, registrationData: REF];
eventTable: RefTab.Ref ← RefTab.Create[];
maps Events to LIST OF DogData
RegisterWatchDog: PUBLIC PROC [event: ATOM, dog: WatchDog, registrationData: REF ← NIL] = {
dogDatas: LIST OF DogData ← NARROW [RefTab.Fetch[eventTable, event].val];
dogDatas ← CONS [[dog, registrationData], dogDatas];
[] ← RefTab.Store[eventTable, event, dogDatas];
};
ForgetWatchDog: PUBLIC PROC [event: ATOM, dog: WatchDog, registrationData: REF ← NIL, equal: PROC [REF, REF] RETURNS [BOOL] ← NIL] = {
dogDatas: LIST OF DogData ← NARROW [RefTab.Fetch[eventTable, event].val];
new: LIST OF DogData ← NIL;
WHILE dogDatas#NIL DO
dd: DogData = dogDatas.first;
same: BOOL ← dd.dog=dog AND (IF equal=NIL THEN dd.registrationData=registrationData ELSE equal[dd.registrationData, registrationData]);
IF NOT same THEN new ← CONS [dogDatas.first, new];
dogDatas ← dogDatas.rest;
ENDLOOP;
[] ← RefTab.Store[eventTable, event, new];
};
Broadcast: PUBLIC PROC [event: ATOM, arg1, arg2, arg3: REF ← NIL] = {
dogDatas: LIST OF DogData ← NARROW [RefTab.Fetch[eventTable, event].val];
WHILE dogDatas#NIL DO
dd: DogData ← dogDatas.first;
dd.dog[arg1, arg2, arg3, dd.registrationData];
dogDatas ← dogDatas.rest;
ENDLOOP;
};
Replacement Events
replaceEvent: PUBLIC ATOM ← $Replace;
ReplaceDogData: TYPE = REF ReplaceDogDataRec;
ReplaceDogDataRec: TYPE = RECORD [root: Pipal.Object, dog: ReplaceWatchDog];
GenericReplaceWatchDog: WatchDog = {
rdd: ReplaceDogData = NARROW [registrationData];
table: ReplaceTable = NARROW [arg1];
rdd.dog[rdd.root, table];
};
EqualReplaceDogData: PROC [ref1, ref2: REF] RETURNS [BOOL] = {
rdd1: ReplaceDogData = NARROW [ref1];
rdd2: ReplaceDogData = NARROW [ref2];
RETURN [rdd1^=rdd2^];
};
RegisterReplaceWatchDog: PUBLIC PROC [root: Pipal.Object, dog: ReplaceWatchDog] = {
rdd: ReplaceDogData = NEW [ReplaceDogDataRec ← [root, dog]];
RegisterWatchDog[replaceEvent, GenericReplaceWatchDog, rdd];
};
ForgetReplaceWatchDog: PUBLIC PROC [root: Pipal.Object, dog: ReplaceWatchDog] = {
rdd: ReplaceDogData = NEW [ReplaceDogDataRec ← [root, dog]];
ForgetWatchDog[replaceEvent, GenericReplaceWatchDog, rdd, EqualReplaceDogData];
};
BroadcastReplace: PUBLIC PROC [table: ReplaceTable] = {
Broadcast[replaceEvent, table];
};
Replacement for Primitive Classes
ReplaceOverlay: ReplaceProc = {
overlay: Pipal.Overlay ← NARROW [parent];
children: Pipal.Objects ← NIL;
FOR i: NAT DECREASING IN [0 .. overlay.size) DO
children ← CONS [map[overlay[i]], children];
ENDLOOP;
newParent ← Pipal.CreateOverlay[children];
};
ReplaceIcon: ReplaceProc = {
icon: Pipal.Icon ← NARROW [parent];
newParent ← Pipal.CreateIcon[map[icon.reference], map[icon.referent]];
};
ReplaceAnnotation: ReplaceProc = {
annotation: Pipal.Annotation ← NARROW [parent];
newParent ← Pipal.CreateAnnotation[map[annotation.child], annotation.key, annotation.value];
};
unnecessary!
ReplaceIntTransform: ReplaceProc = {
transform: PipalInt.Transform ← NARROW [parent];
newParent ← PipalInt.TransformObject[transform.transformation, map[transform.child]];
};
unnecessary!
ReplaceTranslation: ReplaceProc = {
translation: PipalInt.Translation ← NARROW [parent];
newParent ← PipalInt.TransformObject[[translation.vector], map[translation.child]];
};
unnecessary!
ReplaceOrient: ReplaceProc = {
orient: PipalInt.Orient ← NARROW [parent];
newParent ← PipalInt.TransformObject[[PipalInt.zeroVector, orient.orientation], map[orient.child]];
};
ReplaceAbut: ReplaceProc = {
abut: PipalInt.Abut ← NARROW [parent];
children: Pipal.Objects ← NIL;
FOR i: NAT DECREASING IN [0 .. abut.size) DO
children ← CONS [map[abut[i]], children];
ENDLOOP;
newParent ← PipalInt.CreateAbut[abut.inX, children];
};
unnecessary!
ReplaceRealTransform: ReplaceProc = {
transform: PipalReal.Transform ← NARROW [parent];
newParent ← PipalReal.CreateTransform[transform.transformation, map[transform.child]];
};
Undo / Redo facilities
Do: PUBLIC PROC [old: UndoRedo, message: Pipal.ROPE, oldState: REF] RETURNS [new: UndoRedo] = {
event: Event = [message: message, state: oldState];
completeMessage: Pipal.ROPE ← IO.PutFR["Doing %g.\n", IO.rope[message]];
new ← old;
IF old.redo#NIL THEN {
event: Event = [message: old.redo.first.message, state: oldState];
new.undo ← CONS [event, new.undo];
FOR events: Events ← old.redo, events.rest UNTIL events=NIL DO
events.first.message ← IF events.rest=NIL THEN completeMessage ELSE events.rest.first.message;
new.undo ← CONS [events.first, new.undo];
ENDLOOP;
new.redo ← NIL;
};
TerminalIO.PutRope[completeMessage];
new.undo ← CONS [event, new.undo];
};
Undo: PUBLIC UndoRedoOp = {
IF old.undo=NIL THEN ERROR Pipal.Error[$cantUndo]
ELSE {
event: Event ← old.undo.first;
TerminalIO.PutF["Undoing %g.\n", IO.rope[event.message]];
new.undo ← old.undo.rest;
newState ← event.state;
event.state ← oldState;
new.redo ← CONS [event, old.redo];
};
};
Redo: PUBLIC UndoRedoOp = {
IF old.redo=NIL THEN ERROR Pipal.Error[$cantRedo]
ELSE {
event: Event ← old.redo.first;
TerminalIO.PutF["Redoing %g.\n", IO.rope[event.message]];
new.redo ← old.redo.rest;
newState ← event.state;
event.state ← oldState;
new.undo ← CONS [event, old.undo];
};
};
Reset: PUBLIC UndoRedoOp = {
new ← old;
newState ← oldState;
WHILE new.undo#NIL DO [new, newState] ← Undo[new, newState] ENDLOOP;
};
Hacks
wDir: PUBLIC Pipal.ROPE ← NARROW [ProcessProps.GetProp[$WorkingDirectory]];
Initialization
EnumerateIcon: EnumerateProc ~ {
icon: Pipal.Icon ← NARROW [object];
quit ← each[icon.reference] OR each[icon.referent];
};
Pipal.PutClassMethod[Pipal.overlayClass, replaceMethod, NEW [ReplaceProc ← ReplaceOverlay]];
Pipal.PutClassMethod[Pipal.iconClass, replaceMethod, NEW [ReplaceProc ← ReplaceIcon]];
Pipal.PutClassMethod[Pipal.annotationClass, replaceMethod, NEW [ReplaceProc ← ReplaceAnnotation]];
Pipal.PutClassMethod[PipalInt.transformClass, replaceMethod, NEW [ReplaceProc ← ReplaceIntTransform]];
Pipal.PutClassMethod[PipalInt.translationClass, replaceMethod, NEW [ReplaceProc ← ReplaceTranslation]];
Pipal.PutClassMethod[PipalInt.orientClass, replaceMethod, NEW [ReplaceProc ← ReplaceOrient]];
Pipal.PutClassMethod[PipalInt.abutClass, replaceMethod, NEW [ReplaceProc ← ReplaceAbut]];
Pipal.PutClassMethod[PipalReal.transformClass, replaceMethod, NEW [ReplaceProc ← ReplaceRealTransform]];
Pipal.PutClassMethod[Pipal.iconClass, enumerateMethod, NEW [EnumerateProc ← EnumerateIcon]];
speed ups!
Pipal.PutClassMethod[Pipal.overlayClass, enumerateMethod, NEW [EnumerateProc ← EnumerateOverlay]];
Pipal.PutClassMethod[Pipal.annotationClass, enumerateMethod, NEW [EnumerateProc ← EnumerateAnnotation]];
Pipal.PutClassMethod[PipalInt.transformClass, enumerateMethod, NEW [EnumerateProc ← EnumerateTransform]];
Pipal.PutClassMethod[PipalInt.translationClass, enumerateMethod, NEW [EnumerateProc ← EnumerateTranslation]];
END.