CoreInstCellImpl.mesa
Copyright c 1986 by Xerox Corporation. All rights reserved.
Created by Don Curry, February 1, 1986 2:43:22 pm PST
Edited by Don Curry, May 14, 1986 12:49:57 pm PDT
CoreInstCellImpl:
CEDAR
PROGRAM
IMPORTS CoreBlock, CoreClasses, CoreOps, CoreName, CoreProperties, IO, PWCore
EXPORTS CoreInstCell =
BEGIN
specificGenericCellClass:
PUBLIC Core.CellClass ←
CoreOps.SetClassPrintProc[
class: NEW[ Core.CellClassRec ← [name: "SpecificGeneric", recast: Recast]],
proc: ClassPrintProc];
ClassPrintProc: CoreOps.PrintClassProc = {
cell: Core.CellType ← NARROW [data];
out.PutF["\nSpecificGeneric Instance of: %g", IO.rope[CoreName.CellNm[cell].n]]};
Recast:
PUBLIC Core.RecastProc = {
internal: Core.Wire ← CoreOps.CopyWire[me.public];
cell: Core.CellType ← NARROW [me.data]; -- ERROR -> Why recast an Identity?
public: Core.Wire ← CoreOps.CreateWires[cell.public.size];
actual: Core.Wire ← CoreOps.CreateWires[cell.public.size];
IF cell.public.size#internal.size THEN Signal[];
FOR index: INT IN [0..internal.size) DO actual[index] ← internal[index] ENDLOOP;
FOR index: INT IN [0..internal.size) DO public[index] ← internal[index] ENDLOOP;
new ← CoreClasses.CreateRecordCell[
public: public,
internal: internal,
instances: LIST [CoreClasses.CreateInstance[actual: actual, type: cell]]];
CoreBlock.PutCellSide [new, all];
CoreBlock.MergeSides [new];
PWCore.SetAbutX [new]};
SpecificGeneric:
PUBLIC
PROC[generic: Core.CellType, proc: CoreInstCell.RenameProc]
RETURNS [specific: Core.CellType] = {
ctx: CoreName.Context ← CoreName.NewContext[];
internal: Core.Wire ← CoreOps.CreateWires[generic.public.size];
FOR index:
INT
IN [0..internal.size)
DO
aName: Core.ROPE ← CoreName.WireNm[generic.public[index] ].n;
aName ← proc[aName];
internal[index] ←
IF aName#
NIL
THEN CoreName.CtxWire [ctx, aName]
ELSE CoreOps.CreateWires[0];
ELSE CoreOps.CreateWire[name: CoreName.ID["DeadEnd"]];
ENDLOOP;
IF generic.class # CoreClasses.recordCellClass AND
generic.class # CoreClasses.identityCellClass THEN Signal[];
specific ←
NEW[Core.CellTypeRec ← [
class: specificGenericCellClass,
public: internal,
data: generic,
properties: NIL ]];
ctx ← CoreName.KillContext[ctx]};
Signal: SIGNAL = CODE;
CoreProperties.PutCellClassProp[specificGenericCellClass, PWCore.layoutAtomProp, $Recast];
END.