DIRECTORY Core, CoreOps, CorePrivate, CoreProperties, CoreRecord, IO, Rope, SymTab;

CoreOpsImpl: CEDAR PROGRAM
IMPORTS CoreProperties, CoreRecord, IO, Rope, SymTab
EXPORTS Core, CoreOps = 
BEGIN OPEN Core, CoreOps;

DesignDataRec: PUBLIC TYPE = CorePrivate.DesignDataRec;

StructureError: PUBLIC SIGNAL [type: StructureErrorType, message: ROPE, data: REF ANY _ NIL] RETURNS [newData: REF ANY _ NIL] = CODE;

cellClasses: SymTab.Ref _ SymTab.Create[];

Start: PROC = {
CoreProperties.PropDontPrint[publicWireFullName];
RegisterCellClass[identityCellClass];
};
CreateDesign: PUBLIC PROC [name: ROPE _ NIL, props: Properties _ NIL] RETURNS [design: Design] = {
design _ NEW[DesignRec _ [
name: name,	
data: NEW[DesignDataRec _ [cellTypes: SymTab.Create[]]],
properties: props]];
};

PrintDesign: PUBLIC PROC [design: Design, out: STREAM] = {
PrintDesignCellType: EachEntryAction = {
PrintCellType[cellType: cellType, out: out];
};
IO.PutF[out, "\nDesign: %g", IO.rope[design.name]];
CoreProperties.PrintProperties[props: design.properties, out: out];
[] _ EnumerateCellTypes[design: design, action: PrintDesignCellType];
};
printClassProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePrintClassProc];

RegisterCellClass: PUBLIC PROC [class: CellClass] = {
IF class=NIL OR class.name=NIL THEN [] _ SIGNAL StructureError[MissingParameter, NIL];
IF NOT SymTab.Store[x: cellClasses, key: class.name, val: class] THEN [] _ SIGNAL StructureError[DuplicateName, class.name];
};
InsertCellType: PUBLIC PROC [design: Design, cellType: CellType] = {
createdName: BOOL _ FALSE;
concrete: CorePrivate.ConcreteDesignData _ design.data;
IF design=NIL OR cellType=NIL OR cellType.class=NIL THEN [] _ SIGNAL StructureError[MissingParameter, NIL];
IF cellType.name = NIL THEN {
IF concrete.fakeName=LAST[NAT] THEN {
concrete.fakeNamePrefix _ Rope.Cat[concrete.fakeNamePrefix, "@"];
concrete.fakeName _ 0;
}
ELSE concrete.fakeName _ concrete.fakeName+1;
cellType.name _ IO.PutFR["-noname-%g%g", IO.rope[concrete.fakeNamePrefix], IO.int[concrete.fakeName]];
createdName _ TRUE;
};
IF NOT SymTab.Store[x: concrete.cellTypes, key: cellType.name, val: cellType] THEN IF createdName THEN [] _ SIGNAL StructureError[InvariantFailed, NIL] ELSE [] _ SIGNAL StructureError[DuplicateName, cellType.name];
};

FetchCellType: PUBLIC PROC [design: Design, name: ROPE] RETURNS [cellType: CellType] = {
concrete: CorePrivate.ConcreteDesignData _ design.data;
IF design=NIL OR name=NIL THEN [] _ SIGNAL StructureError[MissingParameter, NIL];
cellType _ NARROW[SymTab.Fetch[x: concrete.cellTypes, key: name].val];
};

EnumerateCellTypes: PUBLIC PROC [design: Design, action: EachEntryAction] RETURNS [quit: BOOL] = {
concrete: CorePrivate.ConcreteDesignData _ design.data;
LclEntryAction: SymTab.EachPairAction = {
quit _ action[cellType: NARROW[val]];
};
IF design=NIL OR action=NIL THEN [] _ SIGNAL StructureError[MissingParameter, NIL];
quit _ SymTab.Pairs[x: concrete.cellTypes, action: LclEntryAction];
};

PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM] = {
classProc: REF PrintClassProc;
IO.PutF[out, "\n\nCell type: %g", IO.rope[cellType.name]];
IO.PutF[out, ", Cell class: %g", IO.rope[cellType.class.name]];
IO.PutRope[out, "\nPublic wire:"];
PrintWire[cellType.publicWire, out];
IF (classProc _ NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN classProc[cellType.data, out];
CoreProperties.PrintProperties[props: cellType.properties, out: out];
};

identityCellClass: CellClass _ NEW[CellClassRec _ [name: "Identity", recast: IdentityRecast, read: IdentityRead, write: IdentityWrite, properties: CoreProperties.Props[[printClassProcProp, NEW[PrintClassProc _ IdentityPrint]]]]];

Identity: PUBLIC PROC [cellType: CellType, name: ROPE, props: Properties _ NIL] RETURNS [identity: CellType] = {
identity _ NEW[CellTypeRec _ [
name: name,
class: identityCellClass,
publicWire: CopyWire[wire: cellType.publicWire],
data: cellType,
properties: props]];
};

IdentityRecast: RecastProc = {
new _ me;
WHILE new.class=identityCellClass DO new _ NARROW[new.data]; ENDLOOP;
};

IdentityRead: ReadProc = {
ERROR;
};

IdentityWrite: WriteProc = {
ERROR;
};

IdentityPrint: PrintClassProc = {
ct: CellType _ NARROW[data];
out.PutF["\nIdentity of %g", IO.rope[ct.name]];
};

recastCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreRecastCache];

Recast: PUBLIC RecastProc = {
value: REF _ CoreProperties.GetProp[me.properties, recastCacheProp];
IF value#NIL THEN RETURN [NARROW[value]];
new _ me.class.recast[me];
me.properties _ CoreProperties.PutProp[me.properties, recastCacheProp, new];
};
CreateSequenceWire: PUBLIC PROC [name: ROPE _ NIL, components: LIST OF Wire, props: Properties _ NIL] RETURNS [wire: Wire] = {
wire _ CreateRecordWire[name, components, props];
FOR w: NAT IN [1..wire.elements.size) DO
IF NOT CoreRecord.Conform[w1: wire.elements[0], w2: wire.elements[w]] THEN ERROR;
ENDLOOP;
};

CreateRecordWire: PUBLIC PROC [name: ROPE _ NIL, components: LIST OF Wire, props: Properties _ NIL] RETURNS [wire: Wire] = {
fieldCount: NAT _ 0;
FOR c: LIST OF Wire _ components, c.rest UNTIL c=NIL DO
fieldCount _ fieldCount + 1;
ENDLOOP;
wire _ NEW[WireRec _ [
name: name,
structure: record,
elements: NEW[WireSequenceRec[fieldCount]],
properties:  props]];
fieldCount _ 0;
FOR c: LIST OF Wire _ components, c.rest UNTIL c=NIL DO
wire.elements[fieldCount] _ c.first;
fieldCount _ fieldCount + 1;
ENDLOOP;
};

CreateAtomWire: PUBLIC PROC [name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
wire _ NEW[WireRec _ [
name: name,
structure: atom,
properties:  props]];
};

CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = {
RecurseCopy: PROC [wire: Wire] RETURNS [new: Wire] = {
IF wire=NIL THEN RETURN[NIL];
new _ NEW[WireRec _ wire^];
IF wire.elements#NIL THEN {
new.elements _ NEW[WireSequenceRec[wire.elements.size]];
FOR i:NAT IN [0..wire.elements.size) DO
new.elements[i] _ RecurseCopy[wire.elements[i]];
ENDLOOP;
};
new.properties _ CoreProperties.CopyProps[propList: wire.properties];
};
new _ RecurseCopy[wire];
};

VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc]= {
RecurseOnWire: PROC [wire: Wire] RETURNS [quit: BOOL _ FALSE] = {
notSubWires: BOOL;
[notSubWires, quit] _ eachWire[wire];
IF NOT quit AND NOT notSubWires AND wire.elements#NIL THEN
FOR i:NAT IN [0..wire.elements.size) DO
quit _ RecurseOnWire[wire.elements[i]];
IF quit THEN EXIT;
ENDLOOP;
};
IF wire#NIL THEN [] _ RecurseOnWire[wire];
};

PrintWire: PUBLIC PROC [wire: Wire, out: STREAM] = {
depth: NAT _ 1;
RecursePrintWire: PROC [wire: Wire] = {
PrintIndent[depth, out];
IO.PutF[out, "%g, %g", IF wire.name=NIL THEN IO.rope["<no name>"] ELSE IO.refAny[wire.name], IO.rope[SELECT wire.structure FROM
atom => "atom",
record => "record",
sequence => "sequence",
ENDCASE => ERROR]];
IF wire.structure#atom THEN IO.PutF[out, ", %g elements", IO.int[wire.elements.size]];
CoreProperties.PrintProperties[props: wire.properties, out: out, depth: depth+1];
IF wire.elements#NIL THEN {
depth _ depth + 1;
IF wire.structure=record THEN FOR i: NAT IN [0..wire.elements.size) DO
RecursePrintWire[wire.elements[i]];
ENDLOOP
ELSE RecursePrintWire[wire.elements[0]];
depth _ depth - 1;
};
};
RecursePrintWire[wire: wire];
};

PrintIndent: PUBLIC PROC [depth: NAT, out: STREAM] = {
IO.PutChar[out, IO.CR];
FOR i: NAT IN [0..depth) DO
IO.PutRope[out, "  "];
ENDLOOP;
};

NameWire: PUBLIC PROC [wire: Wire, name: ROPE, prop: ATOM] = {
wire.properties _ CoreProperties.PutProp[on: wire.properties, prop: prop, value: name];
IF wire.elements#NIL THEN {
FOR i:NAT IN [0..wire.elements.size) DO
new: ROPE _ SELECT wire.structure FROM
sequence => IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]],
record => IF wire.elements[i].name#NIL THEN Rope.Cat[name, ".", wire.elements[i].name] ELSE Rope.Cat[name, ".?"],
ENDCASE => ERROR;
NameWire[wire: wire.elements[i], name: new, prop: prop];
ENDLOOP;
};
};

nameClassWireProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreClassWireNameProc];
publicWireFullName: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePublicWireFullName];

NameAllWires: PUBLIC PROC [design: Design] = {
NameCellTypeWires: EachEntryAction = {
classProc: REF NameWireProc;
NameWire[wire: cellType.publicWire, name: cellType.publicWire.name, prop: publicWireFullName];
IF (classProc _ NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: nameClassWireProcProp]]) # NIL THEN classProc[cellType.data];
};
[] _ EnumerateCellTypes[design: design, action: NameCellTypeWires];
};

Start[];

END.

όCoreOpsImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Barth, October 2, 1985 11:28:58 am PDT
Spreitzer, October 3, 1985 5:16:15 pm PDT
Bertrand Serlet October 2, 1985 12:18:37 pm PDT

Designs
Cell Classes
Cell Types
Wires
Κ
τ–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ1™<K™&K™)K™/K™—KšΟk	œ9žœ˜SK˜•StartOfExpansion[]šœ
žœ
ž˜Kšžœžœ˜4Kšžœ˜Kšžœ
žœ˜—K˜Kšœžœ
žœ˜7K˜Kšœžœ
žœ%žœžœ
žœžœžœžœ
žœžœžœ
˜…
K˜Jš
œ*˜*J˜šΟnœžœ˜Kš
œ1˜1Jš
œ%˜%J˜—
headš
œ™šŸœžœ
žœžœžœžœžœ˜bšœ	žœ˜Kš
œ˜Jšœžœ/˜8Jš
œ˜—Kš
œ˜K˜—šŸœžœ
žœžœ˜:šΟbœ˜(J˜,J˜—Jšžœžœ˜3Kš
œC˜CKš
œE˜EKš
œ˜——™Kšœžœ
žœ8˜WK˜šŸœžœ
žœ˜5Kšžœžœ
žœžœ
žœžœ"žœ˜VJšžœ
žœ;žœžœ+˜|J˜——™
šŸœžœ
žœ)˜DKšœ
žœžœ
˜Kš
œ7˜7Kšžœžœ
žœ
žœ
žœžœ
žœžœ"žœ˜kšžœžœ
žœ˜šžœžœ
žœžœ˜%Kš
œA˜AKš
œ˜K˜
—Kšžœ)˜-Kšœžœžœ žœ˜fKšœžœ
˜Kš
œ˜—Jšžœ
žœHžœ
žœ
žœžœ!žœžœžœ.˜Φ
Kš
œ˜K˜—š
Ÿ
œžœ
žœžœžœ˜XKš
œ7˜7Kšžœžœ
žœžœ
žœžœ"žœ˜QKšœžœ5˜FKš
œ˜K˜—š
Ÿœžœ
žœ+žœžœ˜bKš
œ7˜7š
œ)˜)Kšœžœ˜%K˜—Kšžœžœ
žœžœ
žœžœ"žœ˜SKš
œC˜CKš
œ˜K˜—šΠbn
œžœ
žœžœ˜@Kšœžœ˜Kšžœ žœ˜:Kšžœžœ˜?Kšžœ ˜"Kš
œ$˜$KšžœžœWžœ
žœ˜”
Jš
œE˜EJ˜K˜—šœžœ›
žœ%˜ε
K˜—šŸœžœ
žœžœžœžœ˜pšœžœ˜Kš
œ˜Kš
œ˜Kš
œ0˜0Kš
œ˜Kš
œ˜—Kš
œ˜K˜—š
œ˜K˜	Kšžœžœžœžœ
˜EKš
œ˜K˜—š
œ˜Kšžœ
˜Kš
œ˜K˜—š
œ˜Kšžœ
˜Kš
œ˜K˜—š
œ!˜!Jšœžœ˜Jšœžœ˜/Jš
œ˜J˜—šœžœ5˜JK˜—š œžœ˜Kšœžœ:˜DKš
žœžœ
žœ
žœžœ	˜)Kš
œ˜Kš
œL˜LK˜——™šŸœžœ
žœžœžœžœ
žœžœžœ˜~Kš
œ1˜1šžœžœ
žœž˜(Kšžœ
žœ@žœ
žœ
˜QKšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœžœžœžœ
žœžœžœ˜|Kšœžœ˜šžœžœ
žœžœžœ
ž˜7Kš
œ˜Kšžœ
˜—šœžœ˜K˜Kš
œ˜Kšœ
žœ˜+Kš
œ˜—Kš
œ˜šžœžœ
žœžœžœ
ž˜7Kš
œ$˜$Kš
œ˜Kšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœžœžœžœžœ˜`šœžœ˜K˜Kš
œ˜Kš
œ˜—Kš
œ˜K˜—šŸœžœ
žœžœ˜:šŸœžœžœ˜6Jš
žœžœ
žœ
žœ
žœ˜Jšœžœ˜šžœžœ
žœ˜Jšœžœ&˜8šžœžœ
žœž˜'Jš
œ0˜0Jšžœ
˜—J˜—Jš
œE˜EJ˜—Jš
œ˜Kš
œ˜K˜—šŸ	œžœ
žœ(˜>š
Ÿ
œžœžœžœžœ˜AJšœ
žœ
˜Jš
œ%˜%š
žœ
žœžœ
žœ
žœžœ
ž˜:šžœžœ
žœž˜'Jš
œ'˜'Jšžœžœ
žœ
˜Jšžœ
˜——J˜—Jšžœžœ
žœ˜*Jš
œ˜J˜—šŸ	œžœ
žœžœ˜4Kšœžœ˜šŸœžœ˜'K˜šžœžœžœ
žœ
žœžœ
žœžœžœž˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ˜—Kšžœžœ
žœžœ˜VKš
œQ˜Qšžœžœ
žœ˜Kš
œ˜šžœžœ
žœžœ
žœž˜FKš
œ#˜#Kš
ž˜—Kšžœ$˜(Kš
œ˜K˜—K˜—Kš
œ˜K˜K˜—š
Ÿœžœ
žœ	žœžœ˜6Kšžœžœ
žœ˜šžœžœ
žœž˜Kšžœ˜Kšžœ
˜—K˜K˜—š
Ÿœžœ
žœžœžœ˜>Kš
œW˜Wšžœžœ
žœ˜šžœžœ
žœž˜'šœžœžœž˜&Kšœžœžœ
žœ	˜9Kš	œ
žœžœ
žœ,žœ˜qKšžœžœ
˜—Jš
œ8˜8Jšžœ
˜—J˜—K˜K˜—Kšœžœ
žœ;˜]šœžœ
žœ<˜[K˜—šŸœžœ
žœ˜.š
œ&˜&Kšœžœ˜Jš
œ^˜^KšžœžœZžœ
žœ˜’
J˜—Kš
œC˜CK˜K˜—K˜K˜—Kšžœ
˜K˜—…—!z-j