RoseTypeStringImpl.Mesa
Spreitzer, October 1, 1985 6:59:10 pm PDT
Barth, September 10, 1985 8:26:25 pm PDT
DIRECTORY Core, CoreProperties, IO, Rope, RoseBind, RoseBindPrivate, RoseTranslate, RoseWireTypes;
RoseTypeStringImpl: CEDAR PROGRAM
IMPORTS CoreProperties, IO, Rope, RoseBind
EXPORTS RoseBind, RoseTranslate
=
BEGIN OPEN RoseWireTypes, RoseTranslate;
BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
TypeStringFromClass: PUBLIC PROC [bc: RoseBindPrivate.BehaviorClass] RETURNS [ts: TypeString] = {
out: IO.STREAM ← IO.ROS[];
Work: PROC [w: Core.Wire] = {
first: BOOL ← FALSE;
DoProp: PROC [key: ATOM] = {
val: REF ANY ← CoreProperties.GetProp[w.properties, key];
IF val = NIL THEN RETURN;
IF first THEN first ← FALSE ELSE out.PutRope[" "];
WITH val SELECT FROM
rb: REF BOOL => out.PutF["(%g %g)", [atom[key]], [boolean[rb^]] ];
ENDCASE => out.PutF["(%g %g)", [atom[key]], [refAny[val]] ];
};
out.PutF["(%g ", [refAny[w.name]]];
SELECT w.structure FROM
atom => out.PutRope["(atom) "];
sequence => {
out.PutRope["(sequence "];
Work[w.elements[0]];
out.PutRope[") "];
};
record => {
out.PutRope["(record "];
FOR i: NAT IN [0 .. w.elements.size) DO
Work[w.elements[i]];
ENDLOOP;
out.PutRope[") "];
};
ENDCASE => ERROR;
out.PutRope["("];
DoProp[RoseBind.switchWire];
DoProp[RoseBind.variableWire];
DoProp[RoseBind.complexDrive];
DoProp[RoseBind.simpleDrive];
out.PutRope["))"];
};
Work[bc.publicWirePrototype];
ts ← out.RopeFromROS[];
};
CompareTypeStrings: PUBLIC PROC [a, b: TypeString] RETURNS [differenceReport: ROPE--NIL means equal--] = {
la: LORA ← NARROW[IO.RIS[a].GetRefAny[]];
lb: LORA ← NARROW[IO.RIS[b].GetRefAny[]];
Work: PROC [la, lb: LORA, namePrefixA, namePrefixB: ROPE] RETURNS [differenceReport: ROPE] = {
nameStepA: ROPE = ToName[la.first];
nameStepB: ROPE = ToName[lb.first];
nameA: ROPE = namePrefixA.Cat[".", nameStepA];
nameB: ROPE = namePrefixB.Cat[".", nameStepB];
strA: LORA = NARROW[la.rest.first];
strB: LORA = NARROW[lb.rest.first];
propsA: LORA ← NARROW[la.rest.rest.first];
propsB: LORA ← NARROW[lb.rest.rest.first];
IF la.rest.rest.rest # NIL OR lb.rest.rest.rest # NIL THEN ERROR;
IF NOT nameStepA.Equal[nameStepB] THEN RETURN [IO.PutFR[
"name disagreement at %g ~ %g",
[rope[nameA]],
[rope[nameB]]
]];
IF strA.first # strB.first THEN RETURN [IO.PutFR[
"structural disagreement (%g vs %g) at %g ~ %g",
[atom[NARROW[strA.first]]],
[atom[NARROW[strB.first]]],
[rope[nameA]],
[rope[nameB]]
]];
SELECT strA.first FROM
$atom => NULL;
$sequence => IF (differenceReport ← Work[NARROW[strA.rest.first], NARROW[strB.rest.first], nameA, nameB]) # NIL THEN RETURN;
$record => {
subsA: LORA ← strA.rest;
subsB: LORA ← strB.rest;
WHILE subsA # NIL AND subsB # NIL DO
IF (differenceReport ← Work[NARROW[subsA.first], NARROW[subsB.first], nameA, nameB]) # NIL THEN RETURN;
subsA ← subsA.rest;
subsB ← subsB.rest;
ENDLOOP;
IF subsA # NIL OR subsB # NIL THEN RETURN [IO.PutFR[
"different number of children at %g ~ %g",
[rope[nameA]],
[rope[nameB]]
]];
};
ENDCASE => ERROR;
WHILE propsA # NIL AND propsB # NIL DO
pairA: LORA = NARROW[propsA.first];
pairB: LORA = NARROW[propsB.first];
keyA: ATOM = NARROW[pairA.first];
keyB: ATOM = NARROW[pairB.first];
valA: REF ANY = pairA.rest.first;
valB: REF ANY = pairB.rest.first;
valEq: BOOL ← valA = valB;
IF pairA.rest.rest # NIL OR pairB.rest.rest # NIL THEN ERROR;
IF keyA # keyB THEN RETURN [IO.PutFR[
"property list difference (%g vs %g) at %g ~ %g",
[atom[keyA]],
[atom[keyB]],
[rope[nameA]],
[rope[nameB]]
]];
WITH valA SELECT FROM
rba: REF BOOL => WITH valB SELECT FROM
rbb: REF BOOL => valEq ← rba^ = rbb^;
ENDCASE;
ENDCASE;
IF NOT valEq THEN RETURN [IO.PutFR[
"property %g value difference (%g vs %g) at %g ~ %g",
[atom[keyA]],
[refAny[valA]],
[refAny[valB]],
[rope[nameA]],
[rope[nameB]]
]];
propsA ← propsA.rest;
propsB ← propsB.rest;
ENDLOOP;
IF propsA # NIL OR propsB # NIL THEN RETURN [IO.PutFR[
"different number of properties, at %g ~ %g",
[rope[nameA]],
[rope[nameB]]
]];
RETURN [NIL];
};
differenceReport ← Work[la, lb, NIL, NIL];
};
ToName: PROC [ra: REF ANY] RETURNS [asRope: ROPE] = {
asRope ← NARROW[ra];
};
END.