RoseWiringImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, September 5, 1985 7:17:02 pm PDT
Spreitzer, October 2, 1985 9:32:57 pm PDT
DIRECTORY Basics, CoreProperties, RedBlackTree, Rope, RoseBind, RoseWireClasses, RoseWireTypes, RoseWiring;
RoseWiringImpl:
CEDAR
PROGRAM
IMPORTS CP: CoreProperties, RedBlackTree, Rope, RoseBind, RoseWireClasses
EXPORTS RoseWiring =
BEGIN OPEN RoseWireClasses, RoseWiring;
ROPE: TYPE = Rope.ROPE;
Wire: TYPE = RoseWireTypes.Wire;
protoToRWC:
ARRAY RoseWireTypes.WireFlavor
OF
ATOM = [
simple: CP.RegisterProperty[$RoseWiringImplProtoToSimpleRWC],
switch: CP.RegisterProperty[$RoseWiringImplProtoToSwitchRWC],
drive: CP.RegisterProperty[$RoseWiringImplProtoToDriveRWC]
];
Derivation: TYPE = REF DerivationRec;
DerivationRec:
TYPE =
RECORD [
prototype: Wire,
class: RoseWireTypes.RoseWireClass
];
classes:
ARRAY RoseWireTypes.WireFlavor
OF RoseWireTypes.SymbolTable ← [
simple: RedBlackTree.Create[GetRWCKey, RWCCompare],
switch: RedBlackTree.Create[GetRWCKey, RWCCompare],
drive: RedBlackTree.Create[GetRWCKey, RWCCompare]
];
nameOverride: ATOM ← CP.RegisterProperty[$RoseWireNameOverride];
ComputeWiring:
PUBLIC
PROC [publicWirePrototype: Wire, betterName:
ROPE ←
NIL]
RETURNS [cw: RoseWireTypes.BehaviorClassWiring] = {
OverrideName[publicWirePrototype, betterName];
cw ←
NEW [RoseWireTypes.BehaviorClassWiringRep ← [
simple: GetWiring[publicWirePrototype, simple],
switch: GetWiring[publicWirePrototype, switch],
drive: GetWiring[publicWirePrototype, drive]
]];
};
GetWiring:
PUBLIC
PROC [proto: Wire, flavor: RoseWireTypes.WireFlavor]
RETURNS [rwc: RoseWireTypes.RoseWireClass] = {
drv: Derivation;
rwc ← NARROW[PV[proto, protoToRWC[flavor]]];
IF rwc # NIL THEN RETURN;
drv ← NARROW[classes[flavor].Lookup[proto]];
IF drv =
NIL
THEN {
SELECT
TRUE
FROM
proto.structure = atom
=> rwc ←
SELECT flavor
FROM
simple => GetBool[],
switch => GetBit[],
drive => GetDrive[],
ENDCASE => ERROR;
flavor=drive
AND
PV[proto, RoseBind.simpleDrive] #
NIL
=> rwc ← GetDrive[];
proto.structure = record
=> rwc ← GetRecord[proto, flavor];
proto.structure = sequence
AND
PV[proto, RoseBind.variableWire] #
NIL
=> rwc ← GetVariableSequence[proto, flavor];
proto.structure = sequence
AND proto.elements[0].structure = atom
AND flavor = simple
=> rwc ← GetBasicSequence[proto];
proto.structure = sequence
AND proto.elements[0].structure = atom
AND flavor = drive
AND
PV[proto, RoseBind.complexDrive] =
NIL
=> rwc ← GetDrive[];
proto.structure = sequence
=> rwc ← GetFixedSequence[proto, flavor];
ENDCASE => ERROR;
drv ← NEW[DerivationRec ← [prototype: proto, class: rwc]];
classes[flavor].Insert[drv, proto];
}
ELSE rwc ← drv.class;
CP.PutWireProp[proto, protoToRWC[flavor], rwc];
};
OverrideName:
PROC [w: Wire, name:
ROPE] = {
CP.PutWireProp[w, nameOverride, name];
};
WireName:
PUBLIC
PROC [w: Wire]
RETURNS [name:
ROPE] = {
name ← NARROW[CP.GetWireProp[w, nameOverride]];
IF name = NIL THEN name ← w.name;
};
GetRWCKey:
PROC [data:
REF
ANY]
RETURNS [proto: Wire]
--RedBlackTree.GetKey-- = {
drv: Derivation ← NARROW[data];
proto ← drv.prototype;
};
RWCCompare:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- = {
k1: Wire ← NARROW[k];
k2: Wire ← GetRWCKey[data];
c ← WireCompare[k1, k2];
};
WireCompare:
PROC [w1, w2: Wire]
RETURNS [c: Basics.Comparison] = {
IF (c ← WireName[w1].Compare[WireName[w2]]) # equal THEN RETURN;
IF (c ← INTCompare[ORD[w1.structure], ORD[w2.structure]]) # equal THEN RETURN;
IF w1.structure = atom THEN RETURN;
IF (c ← BoolCompare[SimpleDrive[w1], SimpleDrive[w2]]) # equal THEN RETURN;
SELECT w1.structure
FROM
record => c ← RecordCompare[w1, w2];
sequence => {
IF (c ← BoolCompare[IsVariable[w1], IsVariable[w2]]) # equal THEN RETURN;
IF (c ← WireCompare[w1.elements[0], w2.elements[0]]) # equal THEN RETURN;
IF NOT IsVariable[w1] THEN c ← INTCompare[w1.elements.size, w2.elements.size];
};
ENDCASE => ERROR;
};
RecordCompare:
PROC [w1, w2: Wire]
RETURNS [c: Basics.Comparison] = {
IF (c ← INTCompare[w1.elements.size, w2.elements.size]) # equal THEN RETURN;
FOR i:
INT
IN [0 .. w1.elements.size)
DO
e1: Wire ← w1.elements[i];
e2: Wire ← w2.elements[i];
IF (c ← e1.name.Compare[e2.name]) # equal THEN RETURN;
IF (c ← WireCompare[e1, e2]) # equal THEN RETURN;
ENDLOOP;
c ← equal;
};
SimpleDrive:
PROC [w: Wire]
RETURNS [
BOOL] = {
simple: BOOL = TRUE;
complex: BOOL = FALSE;
IF PV[w, RoseBind.simpleDrive] # NIL THEN RETURN [simple];
IF PV[w, RoseBind.complexDrive] # NIL THEN RETURN [complex];
IF w.structure = sequence AND w.elements[0].structure = atom THEN RETURN [simple];
RETURN [complex];
};
IsVariable:
PROC [w: Wire]
RETURNS [
BOOL] =
{RETURN [PV[w, RoseBind.variableWire] # NIL]};
PV:
PROC [w: Wire, prop:
ATOM]
RETURNS [val:
REF
ANY] =
{val ← CP.GetWireProp[w, prop]};
INTCompare:
PROC [i1, i2:
INT]
RETURNS [c: Basics.Comparison] = {
c ←
SELECT i1
FROM
< i2 => less,
= i2 => equal,
> i2 => greater,
ENDCASE => ERROR;
};
BoolCompare:
PROC [i1, i2:
BOOL]
RETURNS [c: Basics.Comparison] = {
c ←
SELECT i1
FROM
< i2 => less,
= i2 => equal,
> i2 => greater,
ENDCASE => ERROR;
};
END.