CoreOpsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, December 5, 1985 12:48:50 pm PST
Spreitzer, December 1, 1985 6:56:42 pm PST
Bertrand Serlet November 26, 1985 3:23:19 pm PST
Louis Monier December 16, 1985 3:20:39 pm PST
DIRECTORY AMBridge, AMTypes, Core, CoreOps, CoreProperties, IO, PrintTV, RefTab, Rope;
CoreOpsImpl: CEDAR PROGRAM
IMPORTS AMBridge, CoreProperties, IO, PrintTV, RefTab, Rope
EXPORTS CoreOps =
BEGIN OPEN Core, CoreOps;
Names
nameProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreName,
CoreProperties.Props[
[CoreProperties.propCopy, CoreProperties.PropDoCopy],
[CoreProperties.propPrint, CoreProperties.PropDontPrint]
]];
Cell Classes
printClassProcProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CorePrintClassProc];
Cell Types
CreateCellType: PUBLIC PROC [class: CellClass, public: Wire, 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\n%g: %g Cell Type",
[rope[GetCellTypeName[cellType]]],
[rope[cellType.class.name]]
];
IO.PutRope[out, "\nPublic wire:"];
PrintWire[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
CreateWire: PUBLIC PROC [size: NAT ← 0, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
wire ← NEW [WireRec[size]];
wire.properties ← props;
FOR i: NAT IN [0 .. size) DO
wire[i] ← CreateWire[];
ENDLOOP;
IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name];
};
CreateSequenceWire: PUBLIC PROC [elements: LIST OF Wire, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
wire ← WiresToWire[elements, name, props];
CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp];
FOR w: NAT IN [1 .. wire.size) DO
IF ~Conform[wire[0], wire[w]] THEN ERROR;
ENDLOOP;
};
SubrangeWire: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [sub: Wire] = {
sub ← CreateWire[size, name, props];
CoreProperties.PutWireProp[sub, sequenceProp, sequenceProp];
FOR i: NAT IN [0 .. size) DO
sub[i] ← wire[start+i];
ENDLOOP;
};
WiresToWire: PUBLIC PROC [wires: LIST OF Wire, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
size: NAT ← 0;
FOR c: LIST OF Wire ← wires, c.rest UNTIL c=NIL DO
size ← size + 1;
ENDLOOP;
wire ← NEW [WireRec[size]];
wire.properties ← props;
IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name];
size ← 0;
FOR c: LIST OF Wire ← wires, c.rest UNTIL c=NIL DO
wire[size] ← c.first;
size ← size + 1;
ENDLOOP;
};
CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = {
new ← CreateWire[size: wire.size, props: CoreProperties.CopyProps[propList: wire.properties]];
FOR i: NAT IN [0 .. wire.size) DO new[i] ← CopyWire[wire[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 quit OR ~subWires THEN RETURN;
FOR i: NAT IN [0 .. wire.size) DO
IF VisitWire[wire[i], eachWire] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
VisitBinding: PUBLIC PROC [actual, public: Wire, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform
[subWires, quit] ← eachWirePair[actual, public];
IF quit OR ~subWires THEN RETURN;
FOR i: NAT IN [0 .. actual.size) DO
IF VisitBinding[actual[i], public[i], eachWirePair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
Conform: PUBLIC PROC [actual, public: Wire] RETURNS [BOOL] = {
EachWirePair: EachWirePairProc = {};
RETURN [NOT VisitBinding[actual, public, EachWirePair]];
};
WireBits: PUBLIC PROC [wire: Wire] RETURNS [bits: NAT] = {
visitTab: RefTab.Ref ← RefTab.Create[]; -- Wire to ATOM
CountBits: PROC [wire: Wire] RETURNS [bits: NAT ← 0] = {
IF NOT RefTab.Fetch[x: visitTab, key: wire].found THEN {
IF wire.size=0 THEN bits ← 1
ELSE FOR sub: NAT IN [0..wire.size) DO
bits ← bits + CountBits[wire[sub]];
ENDLOOP;
IF NOT RefTab.Insert[x: visitTab, key: wire, val: $Counted] THEN ERROR;
};
};
bits ← CountBits[wire];
};
Naming of Wires (temporary)
GetWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE ← NIL] = {
name ← NARROW [CoreProperties.GetWireProp[wire, nameProp]];
};
GetWireIndex: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [n: INT ← -1] ~ {
FOR i: NAT IN [0..wire.size) DO
IF Rope.Equal[name, GetWireName[wire[i]]] THEN RETURN [i];
ENDLOOP;
};
FullNameWire: PUBLIC PROC [wire: Wire, name: ROPE ← NIL, prop: ATOM ← publicFullName] = {
wire.properties ← CoreProperties.PutProp[on: wire.properties, prop: prop, value: name];
FOR i: NAT IN [0 .. wire.size) DO
new: ROPE ← SELECT TRUE FROM
CoreProperties.GetWireProp[wire, sequenceProp]#NIL
=> IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]],
GetWireName[wire[i]]#NIL
=> IF name=NIL THEN GetWireName[wire[i]] ELSE Rope.Cat[name, ".", GetWireName[wire[i]]],
ENDCASE
=> IF name=NIL THEN "?" ELSE Rope.Cat[name, ".?"];
FullNameWire[wire[i], new, prop];
ENDLOOP;
};
nameClassWireProcProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreClassWireNameProc];
publicFullName: PUBLIC ATOM ← CoreProperties.RegisterProperty[
$CorePublicWireFullName,
CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]
];
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.size#0 THEN IO.PutF[out, ", %g elements", IO.int[wire.size]];
CoreProperties.PrintProperties[props: wire.properties, out: out, depth: depth+1];
FOR i: NAT IN [0 .. wire.size) DO
PrintWire[wire[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.