RoseTranslateDefs.Mesa
Spreitzer, October 23, 1985 11:12:16 pm PDT
Barth, September 10, 1985 8:26:25 pm PDT
DIRECTORY BasicTime, Commander, Core, CoreOps, FS, IO, PutGet, ReHashTable, Rope, RoseBind, RoseBindPrivate, RoseBehavior, RoseControl, RoseTranslate, RoseTranslatePrivate, RoseWireTypes, RoseWireTypeUse, TextNode, TiogaAccess, TiogaFileOps, TiogaStreams, UserCredentials;
RoseTranslateDefs:
CEDAR
PROGRAM
IMPORTS BasicTime, FS, IO, PutGet, ReHashTable, Rope, RoseBindPrivate, RoseControl, RoseTranslate, RoseWireTypes, RoseWireTypeUse, TextNode, TiogaAccess, UserCredentials
EXPORTS RoseBind, RoseTranslate, RoseTranslatePrivate
=
BEGIN OPEN RoseWireTypes, RoseTranslate;
BehaviorClass: TYPE = REF BehaviorClassRec;
BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
ModuleRoot: TYPE = RoseBindPrivate.ModuleRoot;
Writer: TYPE = TiogaAccess.Writer;
TiogaNode: TYPE = TextNode.Ref;
GendPgmPostfixes:
PUBLIC
ARRAY Gend
OF
ROPE ← [
Defs: "RoseDefs",
Private: "RosePrivate"];
stampsIntro: ROPE = "Created from the following behavior class public wire prototypes:";
versionIntro: ROPE = "Created by Rosemary Translator, Version ";
TranslateDefs:
PUBLIC
PROC [moduleRoot: ModuleRoot] = {
w: Writer = TiogaAccess.Create[];
comment: BOOL ← TRUE;
format: ATOM ← $code;
looks: TiogaAccess.Looks ← ALL[FALSE];
Break:
PROC [deltaDepth:
INTEGER] = {
w.Put[[
charSet: 0,
char: '?,
looks: ALL[FALSE],
format: format,
comment: comment,
endOfNode: TRUE,
deltaLevel: deltaDepth,
propList: NIL
]];
};
PutC:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ←
FALSE]
--Rope.ActionType-- = {
w.Put[[
charSet: 0,
char: c,
looks: looks,
format: NIL,
comment: FALSE,
endOfNode: FALSE,
deltaLevel: 0,
propList: NIL
]];
};
PutRope:
PROC [r:
ROPE] = {
r ← r;
[] ← Rope.Map[base: r, action: PutC];
r ← r};
PutF:
PROC [format:
ROPE, v1, v2:
IO.Value ← [null[]] ] = {
r: ROPE = IO.PutFR[format, v1, v2];
PutRope[r];
};
moduleName: ROPE = moduleRoot.name.Concat[GendPgmPostfixes[Defs]];
fileName: ROPE = moduleName.Concat[".Mesa"];
user: RoseWireTypeUse.RoseWireTypeUser ← RoseWireTypeUse.CreateUser[];
repAux: ROPE;
moduleRefs: ARRAY RoseWireTypeUse.ModuleRefType OF LOR;
constants: ReHashTable.Table ← ReHashTable.Create[equal: ReHashTable.RopeEqual, hash: ReHashTable.HashRope];
PerClass:
PROC [bc: BehaviorClass] = {
[] ← RoseBindPrivate.EnsureBCParts[bc, FALSE, FALSE, TRUE];
FOR wf: WireFlavor
IN WireFlavor
DO
rwc: RoseWireClass ← bc.wiring[wf];
user.AddRWCAux[rwc];
ENDLOOP;
DefinePortSteps[bc, user, constants, bc.publicWirePrototype];
bc ← bc;
};
first: BOOL;
WriteHeader[PutRope, Break, fileName, moduleRoot];
comment ← FALSE;
Break[0];
user.NoteModuleRefs[Directory, LIST["RoseBehavior"]];
moduleRoot.EnumerateModuleClasses[PerClass];
[repAux, moduleRefs] ← user.DestroyUser[];
first ← TRUE;
WHILE moduleRefs[Directory] #
NIL
DO
IF first THEN {PutRope["DIRECTORY "]; first ← FALSE} ELSE PutRope[", "];
PutRope[moduleRefs[Directory].first];
moduleRefs[Directory] ← moduleRefs[Directory].rest;
ENDLOOP;
IF NOT first THEN PutRope[";"];
Break[0];
Break[0];
looks['x] ← looks['b] ← TRUE;
PutRope[moduleName];
looks['x] ← looks['b] ← FALSE;
PutRope[": CEDAR DEFINITIONS = {"];
PutRope["\n"];
PutRope[repAux];
PutRope["\n}."];
Break[0];
w.WriteFile[fileName];
};
DefinePortSteps:
PROC [bc: BehaviorClass, user: RoseWireTypeUse.RoseWireTypeUser, constants: ReHashTable.Table, wire: Wire] = {
SELECT wire.structure
FROM
atom => NULL;
record => {
FOR i:
NAT
IN [0 .. wire.elements.size)
DO
ew: Wire = wire.elements[i];
ri: REF INT ← NARROW[constants.Fetch[ew.name].value];
IF ri =
NIL
THEN {
ri ← NEW [INT ← i];
[] ← constants.Store[ew.name, ri];
user.AddMesa[[
mesa:
IO.PutFR[
"%g: CARDINAL = %g",
[rope[ew.name]],
[integer[i]]
],
directory: LIST["RoseBehavior"]
]];
}
ELSE
IF ri^ # i
THEN
SIGNAL RoseControl.Warning[
IO.PutFR[
"Multiple indices for wire name %g in module rooted at %g: %g from public wire prototype of behavior class %g, and %g from ??",
[rope[ew.name]],
[rope[bc.moduleRoot.name]],
[integer[i]],
[rope[bc.name]],
[integer[ri^]]
]];
DefinePortSteps[bc, user, constants, ew];
ENDLOOP;
};
sequence => {
FOR i:
NAT
IN [0 .. wire.elements.size)
DO
ew: Wire = wire.elements[i];
DefinePortSteps[bc, user, constants, ew];
ENDLOOP;
};
ENDCASE => ERROR;
};
TranslatePrivates:
PUBLIC
PROC [moduleRoot: ModuleRoot] = {
w: Writer = TiogaAccess.Create[];
comment: BOOL ← TRUE;
format: ATOM ← $code;
looks: TiogaAccess.Looks ← ALL[FALSE];
Break:
PROC [deltaDepth:
INTEGER] = {
w.Put[[
charSet: 0,
char: '?,
looks: ALL[FALSE],
format: format,
comment: comment,
endOfNode: TRUE,
deltaLevel: deltaDepth,
propList: NIL
]];
};
PutC:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ←
FALSE]
--Rope.ActionType-- = {
w.Put[[
charSet: 0,
char: c,
looks: looks,
format: NIL,
comment: FALSE,
endOfNode: FALSE,
deltaLevel: 0,
propList: NIL
]];
};
PutRope:
PROC [r:
ROPE] = {
r ← r;
[] ← Rope.Map[base: r, action: PutC];
r ← r};
PutF:
PROC [format:
ROPE, v1, v2, v3, v4, v5:
IO.Value ← [null[]] ] = {
r: ROPE = IO.PutFR[format, v1, v2, v3, v4, v5];
PutRope[r];
};
moduleName: ROPE = moduleRoot.name.Concat[GendPgmPostfixes[Private]];
defsModuleName: ROPE = moduleRoot.name.Concat[GendPgmPostfixes[Defs]];
fileName: ROPE = moduleName.Concat[".Mesa"];
user: RoseWireTypeUse.RoseWireTypeUser ← RoseWireTypeUse.CreateUser[];
repAux: ROPE;
moduleRefs: ARRAY RoseWireTypeUse.ModuleRefType OF LOR;
NoteClass:
PROC [bc: BehaviorClass] = {
[] ← RoseBindPrivate.EnsureBCParts[bc, FALSE, FALSE, TRUE];
bc ← bc;
FOR wf: WireFlavor
IN WireFlavor
DO
rwc: RoseWireClass ← bc.wiring[wf];
user.NoteMesa[rwc.super.MesaRepresentation[rwc]];
ENDLOOP;
bc ← bc;
};
WriteRegistration:
PROC [bc: BehaviorClass] = {
PutF[
"RosePrivates.RegisterPrivates[
className: \"%q\",
privates:
NEW [RosePrivates.PrivatesRec ← [
createSwitch: Create%gSwitch,
createSimple: Create%gSimple,
createDrive: Create%gDrive]],
versionStamp: GetMe.GetVersion[]];",
[rope[bc.name]],
[rope[bc.name]],
[rope[bc.name]],
[rope[bc.name]]
];
Break[0];
};
WriteClassStuff:
PROC [bc: BehaviorClass] = {
Break[0];
comment ← TRUE;
format ← $head;
PutF["For behavior class %g:", [rope[bc.name]] ];
Break[+1];
comment ← FALSE;
format ← $code;
FOR wf: WireFlavor
IN WireFlavor
DO
WriteCreator:
PROC [rwc: RoseWireClass] = {
rep, lhs: ROPE;
rep ← rwc.super.MesaRepresentation[rwc].mesa;
Break[0];
PutF[
"Create%g%g: PROC [wire: Core.Wire] RETURNS [ref: REF %g] = {",
[rope[bc.name]],
[rope[WireFlavorName[wf]]],
[rope[rep]]
];
Break[+1];
PutF["ref ← NEW [%g];", [rope[rep]] ];
Break[0];
lhs ← "ref^";
Setup[lhs, "wire", rwc];
PutRope["};"];
Break[-1];
};
Setup:
PROC [lhs, wire:
ROPE, rwc: RoseWireClass] = {
IF rwc.dereference
THEN {
PutF[
"%g ← NEW [%g];",
[rope[lhs]],
[rope[rwc.super.ReferentRep[rwc, wire]]]
];
Break[0];
lhs ← lhs.Concat["^"];
};
IF rwc.addressContaining
THEN {
SELECT rwc.structure
FROM
atom => ERROR;
sequence => {
PutF["FOR i: NAT IN [0 .. %g.elements.size) DO", [rope[wire]] ];
Break[+1];
Setup[
lhs.Concat["[i]"],
wire.Concat[".elements[i]"],
rwc.super.SubClass[rwc, [subscript[0]]]
];
PutRope["ENDLOOP;"];
Break[-1];
};
record => {
FOR i:
NAT
IN [0 .. rwc.length)
DO
selExpr: ROPE = Rope.Cat[".", rwc.super.FieldName[rwc, i]];
sel: Selector = [field[i]];
swc: RoseWireClass = rwc.super.SubClass[rwc, sel];
Setup[
lhs.Concat[selExpr],
IO.PutFR["%g.elements[%g]", [rope[wire]], [integer[i]] ],
swc];
ENDLOOP;
};
ENDCASE => ERROR;
};
};
WriteCreator[bc.wiring[wf]];
ENDLOOP;
bc ← bc;
Break[-1];
};
first: BOOL ← FALSE;
WriteHeader[PutRope, Break, fileName, moduleRoot];
comment ← FALSE;
Break[0];
user.NoteModuleRefs[Directory, LIST["Core", "RoseBehavior", defsModuleName]];
user.NoteModuleRefs[Import, LIST["GetMe", "RosePrivates"]];
user.NoteModuleRefs[Open, LIST[defsModuleName]];
moduleRoot.EnumerateModuleClasses[NoteClass];
[repAux, moduleRefs] ← user.DestroyUser[];
IF repAux.Length[] # 0 THEN ERROR;
first ← TRUE;
WHILE moduleRefs[Directory] #
NIL
DO
IF first THEN {PutRope["DIRECTORY "]; first ← FALSE} ELSE PutRope[", "];
PutRope[moduleRefs[Directory].first];
moduleRefs[Directory] ← moduleRefs[Directory].rest;
ENDLOOP;
IF first THEN ERROR ELSE PutRope[";"];
Break[0];
Break[0];
looks['x] ← looks['b] ← TRUE;
PutRope[moduleName];
looks['x] ← looks['b] ← FALSE;
PutRope[": CEDAR PROGRAM"];
Break[1];
first ← TRUE;
WHILE moduleRefs[Import] #
NIL
DO
IF first THEN {PutRope["IMPORTS "]; first ← FALSE} ELSE PutRope[", "];
PutRope[moduleRefs[Import].first];
moduleRefs[Import] ← moduleRefs[Import].rest;
ENDLOOP;
Break[0];
first ← TRUE;
WHILE moduleRefs[Export] #
NIL
DO
IF first THEN {PutRope["EXPORTS "]; first ← FALSE} ELSE PutRope[", "];
PutRope[moduleRefs[Export].first];
moduleRefs[Export] ← moduleRefs[Export].rest;
ENDLOOP;
Break[0];
PutRope["="];
Break[-1];
PutRope["BEGIN"];
first ← TRUE;
WHILE moduleRefs[Open] #
NIL
DO
IF first THEN {PutRope[" OPEN "]; first ← FALSE} ELSE PutRope[", "];
PutRope[moduleRefs[Open].first];
moduleRefs[Open] ← moduleRefs[Open].rest;
ENDLOOP;
IF NOT first THEN PutRope[";"];
Break[0];
moduleRoot.EnumerateModuleClasses[WriteClassStuff];
Break[0];
comment ← TRUE;
format ← $head;
PutRope["Registrations:"];
Break[+1];
comment ← FALSE;
format ← $code;
Break[0];
moduleRoot.EnumerateModuleClasses[WriteRegistration];
Break[-1];
PutRope["END."];
Break[0];
w.WriteFile[fileName];
};
WriteHeader
:
PROC [
PutRope: PROC [ROPE],
Break: PROC [INTEGER],
fileName: ROPE,
moduleRoot: ModuleRoot
]
= {
first: BOOL ← TRUE;
WriteClass:
PROC [bc: BehaviorClass] = {
ts: TypeString ← RoseTranslate.TypeStringFromClass[bc];
Break[IF first THEN +1 ELSE -1];
PutRope[bc.name];
Break[+1];
PutRope[ts];
first ← FALSE;
};
PutRope[fileName];
Break[+1];
PutRope[versionIntro];
PutRope[translatorVersion];
Break[0];
PutRope[stampsIntro];
moduleRoot.EnumerateModuleClasses[WriteClass];
Break[IF first THEN 0 ELSE -2];
PutRope[IO.PutFR["Created for %g", [rope[UserCredentials.Get[].name]] ]];
Break[0];
PutRope[IO.PutFR["Created at %g", [time[BasicTime.Now[]]] ]];
Break[-1];
};
EnumerateGeneratedStamps:
PUBLIC
PROC [mr: RoseBindPrivate.ModuleRoot, g: Gend, to:
PROC [behaviorClassName:
ROPE, typeString: TypeString]]
RETURNS [translatorStamp:
ROPE ←
NIL] = {
moduleName: ROPE = mr.name.Concat[GendPgmPostfixes[g]];
fileName: ROPE = moduleName.Concat[".Mesa"];
root, node: TiogaNode ← NIL;
in: IO.STREAM;
Dlevel: INTEGER;
gotStamp: ROPE ← NIL;
Consume:
PROC [r:
ROPE]
RETURNS [ok:
BOOL] = {
ENABLE IO.Error, IO.EndOfStream => {ok ← FALSE; CONTINUE};
ok ← TRUE;
FOR i:
INT
IN [0 .. r.Length[])
DO
IF r.Fetch[i] # in.GetChar[] THEN RETURN [FALSE];
ENDLOOP;
ok ← TRUE;
};
first: BOOL ← TRUE;
translatorStamp ← NIL;
root ← PutGet.FromFile[fileName !FS.Error => CONTINUE];
IF root = NIL THEN RETURN;
[node, Dlevel] ← root.Forward[];
IF node = NIL THEN RETURN;
IF Dlevel # 1 THEN RETURN;
IF NOT node.NodeRope[].Equal[fileName] THEN RETURN;
[node, Dlevel] ← node.Forward[];
IF Dlevel # 1 THEN RETURN;
in ← IO.RIS[node.NodeRope[]];
IF NOT Consume[versionIntro] THEN RETURN;
gotStamp ← in.GetLineRope[];
in.Close[];
[node, Dlevel] ← node.Forward[];
IF Dlevel # 0 THEN RETURN;
IF NOT node.NodeRope[].Equal[stampsIntro] THEN RETURN;
DO
stampD: INTEGER ← IF first THEN 1 ELSE -1;
endD: INTEGER ← IF first THEN 0 ELSE -2;
behaviorClassName: ROPE;
typeString: TypeString;
[node, Dlevel] ← node.Forward[];
IF Dlevel = endD THEN EXIT;
IF Dlevel # stampD THEN RETURN;
behaviorClassName ← node.NodeRope[];
[node, Dlevel] ← node.Forward[];
IF Dlevel # 1 THEN RETURN;
typeString ← node.NodeRope[];
to[behaviorClassName, typeString];
first ← FALSE;
ENDLOOP;
translatorStamp ← gotStamp;
};
END.