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.
���ª��RoseWiringImpl.mesa
Copyright c 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
�ÊX��–
"cedar" style˜�codešœ™Kšœ
Ïmœ1™<K™'K™)—K˜�KšÏk	œb˜kK˜�šÏbœžœž˜Kšžœžœ?˜IKšžœ
˜—K˜�Kšžœžœ˜'K˜�Kšžœžœžœ˜Kšœžœ˜ K˜�šœžœžœžœ˜6Kšœžœ3˜=Kšœžœ3˜=Kšœžœ1˜:Kšœ˜—K˜�Kšœžœžœ˜%šœžœžœ˜K˜Kšœ"˜"Kšœ˜K˜�—šœ	žœžœ˜HK˜3K˜3K˜1K˜—K˜�Kšœžœžœ)˜@K˜�šÏn
œžœžœ)žœžœžœ,˜‚Kšœ.˜.šœžœ*˜2Kšœ/˜/Kšœ/˜/Kšœ,˜,K˜—K˜—K˜�š 	œžœžœ1žœ'˜uK˜Kšœžœžœ˜,Kšžœžœžœžœ˜Kšœžœ ˜,šžœžœžœ˜šžœžœž˜šœ˜šœ	žœž˜K˜K˜K˜Kšžœžœ˜——šœ
žœžœ ž˜6Kšœ˜—˜K˜"—šœžœžœ!ž˜EKšœ,˜,—šœžœ$žœ˜UKšœ!˜!—š
œžœ$žœžœžœ!ž˜Kšœ˜—šœ˜Kšœ)˜)—Kšžœžœ˜—Kšœžœ1˜:Kšœ#˜#K˜—Kšžœ˜Kšžœ-˜/K˜—K˜�š œžœžœ˜,Kšžœ$˜&K˜—K˜�š
 œžœžœžœžœ˜8Kšœžœžœ˜/Kšžœžœžœ˜!K˜—K˜�š 	œžœžœžœžœÏcœ˜QKšœžœ˜Kšœ˜K˜—K˜�š 
œžœžœžœžœ¡œ˜_Kšœžœ˜K˜K˜K˜—K˜�š œžœžœ˜CKšžœ2žœžœ˜@Kš
žœžœžœžœžœ˜NKšžœžœžœ˜#Kšžœ=žœžœ˜Kšžœž˜K˜$˜
Kšžœ;žœžœ˜IKšžœ;žœžœ˜IKšžœžœžœ4˜NK˜—Kšžœžœ˜—K˜—K˜�š 
œžœžœ˜EKšžœ>žœžœ˜Lšžœžœžœž˜(K˜K˜Kšžœ(žœžœ˜6Kšžœ#žœžœ˜1Kšžœ˜—K˜
K˜—K˜�š œžœžœžœ˜.Kšœžœžœ˜Kšœ	žœžœ˜Kš
žœžœžœžœžœ
˜:Kš
žœžœžœžœžœ˜<Kšžœžœ žœžœ
˜RKšžœ˜K˜—K˜�š 
œžœžœžœ˜+Kšœžœžœžœ˜.—K˜�šžœžœžœžœžœžœ˜7Kšœžœ˜ —K˜�š 
œžœ
žœžœ˜Ašœžœž˜K˜
K˜K˜Kšžœžœ˜—K˜—K˜�š œžœ
žœžœ˜Cšœžœž˜K˜
K˜K˜Kšžœžœ˜—K˜—K˜�Kšžœ˜—�…—����\��^��