DIRECTORY AMBridge, AMTypes, Core, CoreOps, CoreProperties, IO, PrintTV, Rope;

CoreOpsImpl: CEDAR PROGRAM
IMPORTS AMBridge, CoreProperties, IO, PrintTV, Rope
EXPORTS CoreOps = 
BEGIN OPEN Core, CoreOps;
nameProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy]]];
printClassProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePrintClassProc];
CreateCellType: PUBLIC PROC [class: CellClass, public: WireSequence, data: REF ANY _ NIL, name: ROPE _ NIL, props: Properties _ NIL]  RETURNS [cellType: CellType] = {
cellType _ NEW [CellTypeRec _ [class: class, public: public, data: data, properties: props]];
CoreProperties.PutCellTypeProp[cellType, nameProp, name];
};

GetCellTypeName: PUBLIC PROC [cellType: CellType] RETURNS [name: ROPE _ NIL] = {
name _ NARROW [CoreProperties.GetCellTypeProp[cellType, nameProp]];
};

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];
};

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

PrintIndent: PUBLIC PROC [depth: NAT, out: STREAM] = {
IO.PutChar[out, IO.CR];
FOR i: NAT IN [0..depth) DO
IO.PutRope[out, "  "];
ENDLOOP;
};
CreateAtomWire: PUBLIC PROC [name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
wire _ NEW [WireRec _ [properties: props]];
CoreProperties.PutWireProp[wire, nameProp, name];
};
CreateRecordWire: PUBLIC PROC [components: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
wire _ NEW [WireRec _ [
elements: WiresToWireSequence[components],
properties: props]];
CoreProperties.PutWireProp[wire, nameProp, name];
};
CreateBasicSequenceWire: PUBLIC PROC [length: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
wire _ NEW [WireRec _ [elements: NEW [WireSequenceRec[length]], properties:  props]];
CoreProperties.PutWireProp[wire, nameProp, name];
CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp];
FOR i: NAT IN [0 .. length) DO
wire.elements[i] _ CreateAtomWire[];
ENDLOOP;
};
CreateSequenceWire: PUBLIC PROC [components: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
DifferentStructure: EachWirePairProc = {};
wire _ NEW [WireRec _ [
elements: WiresToWireSequence[components],
properties:  props]];
CoreProperties.PutWireProp[wire, nameProp, name];
CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp];
FOR w: NAT IN [1 .. wire.elements.size) DO
IF VisitWirePair[wire.elements[0], wire.elements[w], DifferentStructure] THEN ERROR;
ENDLOOP;
};

SubrangeWire: PUBLIC PROC [wire: Wire, start, length: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [sub: Wire] = {
sub _ CreateBasicSequenceWire[length, name, props];
FOR i: NAT IN [0 .. length) DO
sub.elements[i] _ wire.elements[start+i];
ENDLOOP;
};

WiresToWireSequence: PUBLIC PROC [wires: LIST OF Wire] RETURNS [wireSeq: WireSequence] = {
fieldCount: NAT _ 0;
FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO
fieldCount _ fieldCount + 1;
ENDLOOP;
wireSeq _ NEW [WireSequenceRec[fieldCount]];
fieldCount _ 0;
FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO
wireSeq[fieldCount] _ c.first;
fieldCount _ fieldCount + 1;
ENDLOOP;
};
WireSequenceToWire: PUBLIC PROC [wireSeq: WireSequence] RETURNS [wire: Wire] = {
wire _ NEW [WireRec _ [elements: wireSeq]];
};

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

sequenceProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreSequence, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy]]];
VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
[subWires, quit] _ eachWire[wire];
IF NOT quit AND subWires AND wire.elements#NIL THEN quit _ VisitWireSequence[wire.elements, eachWire];
};
VisitWireSequence: PUBLIC PROC [wireSeq: WireSequence, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
quit _ FALSE;
FOR i: NAT IN [0 .. wireSeq.size) DO
IF VisitWire[wireSeq[i], eachWire] THEN RETURN [TRUE];
ENDLOOP;
};
VisitWirePair: PROC [wire1, wire2: Wire, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
[subWires, quit] _ eachWirePair[wire1, wire2];
IF wire1 = NIL THEN RETURN;
IF quit OR ~subWires OR wire1 = NIL OR (wire1.elements=NIL AND wire2.elements=NIL) THEN RETURN;
IF wire1.elements=NIL OR wire2.elements=NIL THEN RETURN [TRUE]; -- wires do not conform
quit _ VisitBinding[wire1.elements, wire2.elements, eachWirePair];
};

VisitBinding: PUBLIC PROC [actual, public: WireSequence, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform
FOR i: NAT IN [0 .. actual.size) DO
IF VisitWirePair[actual[i], public[i], eachWirePair] THEN RETURN [TRUE];
ENDLOOP;
quit _ FALSE;
};

Conform: PUBLIC PROC [actual, public: WireSequence] RETURNS [BOOL] = {
EachWirePair: EachWirePairProc = {};
RETURN [NOT VisitBinding[actual, public, EachWirePair]];
};
GetWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE _ NIL] = {
name _ NARROW [CoreProperties.GetWireProp[wire, nameProp]];
};

FullNameWire: PROC [wire: Wire, name: ROPE _ NIL, prop: ATOM _ publicFullName] = {
wire.properties _ CoreProperties.PutProp[on: wire.properties, prop: prop, value: name];
IF wire.elements#NIL THEN FullNameWireSequence[wire.elements, name, prop, CoreProperties.GetWireProp[wire, sequenceProp]#NIL];
};
FullNameWireSequence: PUBLIC PROC [wireSeq: WireSequence, name: ROPE _ NIL, prop: ATOM _ publicFullName, isSequence: BOOL _ FALSE] = {
FOR i: NAT IN [0 .. wireSeq.size) DO
new: ROPE _ IF isSequence 
THEN IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]] 
ELSE IF GetWireName[wireSeq[i]]#NIL 
THEN Rope.Cat[name, ".", GetWireName[wireSeq[i]]] 
ELSE Rope.Cat[name, ".?"];
FullNameWire[wire: wireSeq[i], name: new, prop: prop];
ENDLOOP;
};

nameClassWireProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreClassWireNameProc];
publicFullName: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePublicWireFullName];
PrintWire: PUBLIC PROC [wire: Wire, out: STREAM, depth: NAT _ 0] = {
name: ROPE _ GetWireName[wire];
PrintIndent[depth, out];
IO.PutF[out, "%g", IF name=NIL THEN IO.rope["<no name>"] ELSE IO.rope[name]];
IF wire.elements#NIL 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 PrintWireSequence[wire.elements, out, depth + 1];
};
PrintWireSequence: PUBLIC PROC [wireSeq: WireSequence, out: STREAM, depth: NAT _ 0] = {
FOR i: NAT IN [0 .. wireSeq.size) DO
PrintWire[wireSeq[i], out, depth+1];
ENDLOOP;
};
Reverse: PUBLIC PROC [wires: LIST OF Wire] RETURNS [revWires: LIST OF Wire _ NIL] = {
WHILE wires#NIL DO revWires _ CONS [wires.first, revWires]; wires _ wires.rest ENDLOOP;
};
Delete: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [newWires: LIST OF Wire _ NIL] = {
WHILE wires#NIL DO
IF wires.first#wire THEN newWires _ CONS [wires.first, newWires];
wires _ wires.rest;
ENDLOOP;
};
Member: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [BOOL] = {
WHILE wires#NIL DO IF wires.first=wire THEN RETURN [TRUE]; wires _ wires.rest ENDLOOP;
RETURN [FALSE];
};

InternalPrintCellType: PrintTV.TVPrintProc = {
cellType: CellType;
ref: REF READONLY ANY;
TRUSTED {ref _ AMBridge.SomeRefFromTV[tv]};
cellType _ NARROW [ref, REF READONLY CellType]^;
stream.PutF["{CellType - class: %g, public: ", IO.rope[cellType.class.name]];
Print[ref: cellType.public, stream: stream, depth: depth-1, width: width, verbose: verbose];
stream.PutF[", data: "];
Print[ref: cellType.data, stream: stream, depth: depth-1, width: width, verbose: verbose];
stream.PutF[", properties: "];
Print[ref: cellType.properties, stream: stream, depth: depth-1, width: width, verbose: verbose];
stream.PutF["}"];
};

Print: PROC [ref: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = {
tv: AMTypes.TV;
TRUSTED {tv _ AMBridge.TVForReferent[NEW [REF _ ref]]};
PrintTV.Print[tv, stream, depth, width, verbose];
};


END.

CoreOpsImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Barth, November 5, 1985 3:27:40 pm PST
Spreitzer, November 7, 1985 5:20:45 pm PST
Bertrand Serlet November 13, 1985 3:29:16 pm PST
Frank Bowers January 10, 1986 12:52:33 pm PST

Names
Cell Classes
Cell Types
Creation of Wires
Enumerating Wires
Naming of Wires (temporary)
Printing of Wires (temporary)
Operations on LIST OF Wires
Printing of Core Values (not yet functional)
BS: There is something in the interpreter (or in my understanding of it) that prevents using PrintTV now, but that's the hope
[tv: TV, data: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] RETURNS [useOld: BOOL _ FALSE]
PrintTV.RegisterTVPrintProc[CODE[CellType], InternalPrintCellType];
Κ!–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ1™<K™&K™*K™0K™-K™—KšΟk	œ3žœ˜NK˜•StartOfExpansion[]šœ
žœ
ž˜Kšžœžœ˜3Kšžœ˜Kšžœ
žœ˜—
head™Kšœ
žœ
žœz˜
—™Kšœžœ
žœ8˜W—™
šΟnœžœ
žœ0žœ
žœžœžœžœžœžœ˜¦
KšœžœO˜]Kš
œ9˜9K˜K˜—šŸœžœ
žœžœžœžœ˜PKšœžœ6˜CK˜—K˜Kšœžœ5˜JšΟbœžœ˜Kšœžœ:˜DKš
žœžœ
žœ
žœžœ	˜)Kš
œ˜Kš
œL˜LK˜—K˜š
Πbn
œžœ
žœžœ	žœ	˜PKšœžœ˜Kšžœ žœŸœ
˜FKšžœžœ˜?Kšžœ ˜"Kš
œ1˜1KšžœžœWžœ
žœ˜”
Jš
œE˜EJ˜—K˜š
Ÿœžœ
žœ	žœžœ˜6Kšžœžœ
žœ˜šžœžœ
žœž˜Kšžœ˜Kšžœ
˜—K˜——™šŸœžœ
žœžœžœžœ˜`Kšœžœ!˜+Kš
œ1˜1Kš
œ˜—šŸœžœ
žœžœ
žœ
žœžœžœ˜|šœžœ
˜Kš
œ*˜*Kš
œ˜—Kš
œ1˜1Kš
œ˜—šŸœžœ
žœ
žœžœžœžœžœ˜vKšœžœžœ1˜UKš
œ1˜1Kš
œ=˜=šžœžœ
žœž˜Kš
œ$˜$Kšžœ
˜—Kš
œ˜—šŸœžœ
žœžœ
žœ
žœžœžœžœ˜~Kš œ˜*šœžœ
˜Kš
œ*˜*Kš
œ˜—Kš
œ1˜1Kš
œ=˜=šžœžœ
žœž˜*KšžœGžœ
žœ
˜TKšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœžœžœžœžœžœ˜}Kš
œ3˜3šžœžœ
žœž˜Kš
œ)˜)Kšžœ
˜—Kš
œ˜K˜—šŸœžœ
žœ	žœ
žœžœ˜ZKšœžœ˜šžœžœ
žœžœžœ
ž˜2Kš
œ˜Kšžœ
˜—Kšœ
žœ˜,Kš
œ˜šžœžœ
žœžœžœ
ž˜2Kš
œ˜Kš
œ˜Kšžœ
˜—K˜—šŸœžœ
žœžœ˜PJšœžœ!˜+K˜K˜—šŸœžœ
žœžœ˜:JšœžœO˜XJšžœžœ
žœ0˜IKš
œ˜—šŸœžœ
žœžœ˜XJšœ	žœ!˜-Jš
žœžœ
žœžœ"žœ
˜LK˜—K˜Kšœžœ
žœ~˜—
—™š
Ÿ	œžœ
žœ&žœžœ˜TJšœ
žœ
˜Jš
œ"˜"Jšžœ
žœžœ
žœžœ
žœ3˜fJš
œ˜—š
Ÿœžœ
žœ1žœžœ˜gJšœžœ
˜
šžœžœ
žœž˜$Jšžœ!žœ
žœžœ˜6Jšžœ
˜—Jš
œ˜—šŸ
œžœ6žœžœ˜aJšœ
žœ
˜Jš
œ.˜.Jšžœ	žœ
žœ
žœ
˜Jšžœžœžœ	žœ
žœžœ
žœžœžœ
žœ
˜_Jšžœžœ
žœžœ
žœ
žœžœΟc˜WJš
œB˜BJš
œ˜K˜—š
‘œžœ
žœ@žœžœ˜qJš	žœžœ
žœžœ’˜Fšžœžœ
žœž˜#Jšžœ3žœ
žœžœ˜HJšžœ
˜—Jšœžœ
˜
Jš
œ˜J˜—š
Ÿœžœ
žœ žœžœ˜FKš œ˜$Kšžœžœ-˜8K˜——™šŸœžœ
žœžœžœžœ˜DKšœžœ.˜;K˜—K˜š
Ÿœžœžœžœžœ˜RKš
œW˜WJšžœžœ
žœ`žœ˜~K˜—šŸœžœ
žœžœžœžœžœžœ˜†
šžœžœ
žœž˜$šœžœžœ˜Kšžœ
žœžœ
žœ	˜2šžœ
žœžœ
˜$Kšžœ.˜2Kšžœ˜——Jš
œ6˜6Jšžœ
˜—K˜K˜—Kšœžœ
žœ;˜]Kšœžœ
žœ<˜W—™š
Ÿ	œžœ
žœžœ	žœ	˜DKšœžœ˜K˜Kšžœžœžœ
žœ
žœžœ
žœ
˜MKš
žœžœ
žœ
žœžœ˜TKš
œQ˜QKšžœžœ
žœ2˜KK˜—š
Ÿœžœ
žœžœ	žœ	˜Wšžœžœ
žœž˜$Kš
œ$˜$Kšžœ
˜—K˜——šœžœ
žœ™šŸœžœ
žœ	žœ
žœžœžœ
žœžœ˜UJš
žœžœ
žœžœ-žœ
˜WJš
œ˜—šŸœžœ
žœ	žœ
žœžœžœ
žœžœ˜`šžœžœ
ž˜Jšžœžœžœ˜AJš
œ˜Jšžœ
˜—Jš
œ˜—šŸœžœ
žœ	žœ
žœžœžœ˜HJšžœžœ
žœ
žœžœ
žœžœžœ
˜VJšžœžœ˜Jš
œ˜——™,Kš
œ}™}K–‚
 -- [tv: TV, data: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] RETURNS [useOld: BOOL _ FALSE]˜š œ˜.Kš
Πck~™~Kš
œ˜Kšœžœ
žœ
žœ
˜Kšžœ$˜+Kšœžœžœ
žœ˜0Kšœ/žœ˜MKš
œ\˜\Kš
œ˜Kš
œZ˜ZKš
œ˜Kš
œ`˜`Kš
œ˜Jš
œ˜—K˜šŸœžœžœ
žœ
žœ	žœ
žœžœžœ˜fKšœžœ
˜Kšžœžœžœ
˜7Kš
œ1˜1K˜—K˜Kšœžœ#™C—K˜Kšžœ
˜K˜—…—#Τ3