DIRECTORY IO, Pipal, PipalInt, PipalMutate, PipalOps, RefTab, TerminalIO; PipalMutateImpl: CEDAR MONITOR IMPORTS IO, Pipal, PipalOps, RefTab, TerminalIO EXPORTS PipalMutate = BEGIN OPEN PipalMutate; 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; }; popEvent: PUBLIC ATOM _ $Pop; BroadcastPop: PUBLIC PROC [mutant: Pipal.Object] = { }; 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! }; commandTableMethod: Pipal.Method = Pipal.RegisterMethod["CommandTable"]; 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. ˜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 Mutation Method Pop Event PipalOps.Broadcast[popEvent, mutant, mutant.object]; Operations Commands For a given mutant this table maps the name of the command to a CommandData record. ΚC˜– "Cedar" stylešœ™Jšœ<™œœœ˜šž œ˜%KšœE˜EK˜—Kšœ˜Kšœœœ˜>Kšœœœœ˜/Kšœ+˜+K˜—š žœœœ+œœœ˜oKšœ<˜˜>K˜—Kš œœ/œ@œ œ˜©K˜K™—šž œœœœœœœœ˜‚Kšœ˜Kšœœ2˜SKšœœ(˜<šœ œ˜Kšœœ˜ Kšœœ5˜@—K˜K˜—šž œœœœ œœœœ œœœ8 œ˜ΘKšœ˜Kšœœ˜Kšœ9˜9KšœW˜WK˜——Jšœ˜—…—T/