PipalMutateImpl.mesa 
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
Bertrand Serlet February 16, 1988 5:03:37 pm PST
Louis Monier January 29, 1988 9:10:26 pm PST
Barth, January 29, 1988 6:24:02 pm PST
DIRECTORY IO, Pipal, PipalInt, PipalMutate, PipalOps, RefTab, TerminalIO;
PipalMutateImpl: CEDAR MONITOR
IMPORTS IO, Pipal, PipalOps, RefTab, TerminalIO
EXPORTS PipalMutate =
BEGIN OPEN PipalMutate;
Mutation Method
mutationMethod: PUBLIC Pipal.Method ← Pipal.RegisterMethod["Mutation"];
HasMutationProc: PUBLIC PROC [object: Pipal.Object] RETURNS [BOOL] = {
RETURN [Pipal.ObjectMethod[object, mutationMethod]#NIL];
};
Mutation: PUBLIC MutationProc = {
mutant ← (NARROW [Pipal.ObjectMethod[object, mutationMethod], REF MutationProc]^)[object];
};
RecursiveEnumerateMutantChildren: PROC [root: Pipal.Object, each: EachChildProc, initialPath: Path] RETURNS [path: Path, quit: BOOL ← FALSE] = {
EachChild: PipalOps.EachChildProc = {
[path, quit] ← RecursiveEnumerateMutantChildren[child, each, path+1];
};
path ← initialPath;
IF HasMutationProc[root] THEN RETURN [path, each[path, root]];
IF NOT PipalOps.HasEnumerate[root] THEN RETURN;
quit ← PipalOps.Enumerate[root, EachChild];
};
EnumerateMutantChildren: PUBLIC PROC [root: Pipal.Object, each: EachChildProc] RETURNS [quit: BOOL ← FALSE] = {
quit ← RecursiveEnumerateMutantChildren[root, each, 0].quit;
};
Pop Event
popEvent: PUBLIC ATOM ← $Pop;
BroadcastPop: PUBLIC PROC [mutant: Pipal.Object] = {
PipalOps.Broadcast[popEvent, mutant, mutant.object];
};
Operations
RecursiveReplaceInPath: PROC [root: Pipal.Object, initialPath, searchedPath: Path, table: PipalOps.ReplaceTable] RETURNS [path: Path, found: BOOL ← FALSE] = {
EachChild: PipalOps.EachChildProc = {
[path, quit] ← RecursiveReplaceInPath[child, path+1, searchedPath, table];
};
path ← initialPath;
IF HasMutationProc[root] THEN
IF path#initialPath
THEN ERROR -- Impossible!
ELSE RETURN [path, TRUE];
IF NOT PipalOps.HasEnumerate[root] THEN RETURN;
found ← PipalOps.Enumerate[root, EachChild];
IF found THEN PipalOps.ReplaceWithTable[root, table];
};
ReplaceInPath: PUBLIC PROC [root: Pipal.Object, path: Path, oldChild, newChild: Pipal.Object] RETURNS [table: PipalOps.ReplaceTable] = {
table ← RefTab.Create[];
[] ← RefTab.Store[table, oldChild, newChild];
IF NOT RecursiveReplaceInPath[root, 0, path, table].found THEN ERROR; -- Impossible!
};
Commands
commandTableMethod: Pipal.Method = Pipal.RegisterMethod["CommandTable"];
For a given mutant this table maps the name of the command to a CommandData record.
CommandData: TYPE = REF CommandDataRec;
CommandDataRec: TYPE = RECORD [command: CommandProc, registrationData: REF ← NIL];
RegisterCommand: PUBLIC ENTRY PROC [class: Pipal.Class, name: ATOM, command: CommandProc, registrationData: REF ← NIL] = {
commandData: CommandData ← NEW [CommandDataRec ← [command, registrationData]];
commandTable: RefTab.Ref ← NARROW [Pipal.GetClassMethod[class, commandTableMethod]];
IF commandTable=NIL THEN {
commandTable ← RefTab.Create[];
Pipal.PutClassMethod[class, commandTableMethod, commandTable];
};
IF NOT RefTab.Store[commandTable, name, commandData] THEN TerminalIO.PutF["*** Command %g for mutant %g overwritten.\n", IO.atom[name], IO.rope[Pipal.ClassName[class]]];
};
FetchCommand: PUBLIC PROC [mutant: Pipal.Object, name: ATOM] RETURNS [command: CommandProc ← NIL, registrationData: REF ← NIL] = {
commandData: CommandData;
commandTable: RefTab.Ref ← NARROW [Pipal.ObjectMethod[mutant, commandTableMethod]];
commandData ← NARROW [RefTab.Fetch[commandTable, name].val];
IF commandData=NIL
THEN RETURN
ELSE RETURN [commandData.command, commandData.registrationData];
};
ApplyCommand: PUBLIC PROC [mutant: Pipal.Object, name: ATOM, arguments: LIST OF REF ← NIL, issuer: REF ← NIL] RETURNS [resultType: ResultType ← none, result: Pipal.Object ← NIL, new: Pipal.Object] = {
command: CommandProc;
registrationData: REF;
[command, registrationData] ← FetchCommand[mutant, name];
[resultType, result, new] ← command[mutant, name, arguments, issuer, registrationData];
};
END.