CoreOpsImpl.mesa
Copyright © 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
DIRECTORY AMBridge, AMTypes, Core, CoreOps, CoreProperties, IO, PrintTV, Rope;
CoreOpsImpl: CEDAR PROGRAM
IMPORTS AMBridge, CoreProperties, IO, PrintTV, Rope
EXPORTS CoreOps =
BEGIN OPEN Core, CoreOps;
Names
nameProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy]]];
Cell Classes
printClassProcProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CorePrintClassProc];
Cell Types
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;
};
Creation of Wires
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]]];
Enumerating Wires
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]];
};
Naming of Wires (temporary)
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];
Printing of Wires (temporary)
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;
};
Operations on LIST OF Wires
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];
};
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
InternalPrintCellType: PrintTV.TVPrintProc = {
[tv: TV, data: REF ANY, stream: STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOL ← FALSE] RETURNS [useOld: BOOL ← FALSE]
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];
};
PrintTV.RegisterTVPrintProc[CODE[CellType], InternalPrintCellType];
END.