RoseDepsImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, September 5, 1985 7:21:14 pm PDT
Spreitzer, October 2, 1985 10:12:31 pm PDT
DIRECTORY BasicTime, BcdDefs, Core, FS, GetMe, IO, ListerUtils, MakeDo, RedBlackTree, Rope, RoseBind, RoseBindPrivate, RoseDeps, RoseTranslate, RoseWireTypes, RoseWiring, TimeStamp;
RoseDepsImpl:
CEDAR
MONITOR
IMPORTS FS, IO, ListerUtils, MakeDo, RedBlackTree, Rope, RoseBindPrivate, RoseTranslate
EXPORTS RoseDeps, RoseBind
INVARIANT
$Stamp property of a MakeDo.Node for a BCD file, if any, gives version stamp of specified creation of that file.
= BEGIN
ModuleRoot: TYPE = RoseBindPrivate.ModuleRoot;
BehaviorClass: TYPE = REF BehaviorClassRec;
BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
ROPE: TYPE = Core.ROPE;
Gend: TYPE = RoseTranslate.Gend;
Stuff: TYPE = {Details, Private};
GetBehaviorClassDetailsNode:
PUBLIC
PROC [c: BehaviorClass]
RETURNS [n: MakeDo.Node] =
{n ← GetBehaviorClassStuffNodeByName[c.name, Details]};
GetBehaviorClassPrivateNode:
PUBLIC
PROC [c: BehaviorClass]
RETURNS [n: MakeDo.Node] =
{n ← GetBehaviorClassStuffNodeByName[c.name, Private]};
GetBehaviorClassStuffNodeByName:
PROC [className:
ROPE, stuff: Stuff]
RETURNS [n: MakeDo.Node] = {
name: ROPE ← className.Cat[stuffPostfixes[stuff]];
n ← MakeDo.GetNode[name, behaviorClassStuffNodeClasses[stuff]];
};
GetStuffNodeBehaviorClass:
PROC [n: MakeDo.Node, stuff: Stuff]
RETURNS [class: BehaviorClass] = {
nodeName: ROPE = n.PublicPartsOfNode[].name;
className: ROPE = nodeName.Substr[len: nodeName.Length[] - stuffPostfixLengths[stuff]];
class ← RoseBindPrivate.Fetch[className];
};
stuffPostfixes:
ARRAY Stuff
OF
ROPE = [
Details: " RoseBCDet",
Private: " RoseBCPvt"];
stuffPostfixLengths:
ARRAY Stuff
OF
INT = [
Details: stuffPostfixes[Details].Length[],
Private: stuffPostfixes[Private].Length[]];
behaviorClassStuffNodeClasses:
ARRAY Stuff
OF MakeDo.NodeClass ← [
Details: MakeDo.DeclareNodeClass[
name: "Rosemary Behavior Class Details",
CanonizeName: CannonizeBehaviorClassStuffNodeName,
GetTime: GetBehaviorClassDetailsTime
],
Private: MakeDo.DeclareNodeClass[
name: "Rosemary Behavior Class Privates",
CanonizeName: CannonizeBehaviorClassStuffNodeName,
GetTime: GetBehaviorClassPrivateTime
]
];
CannonizeBehaviorClassStuffNodeName:
PROC [ri:
ROPE]
RETURNS [ro:
ROPE] = {
ro ← ri};
GetBehaviorClassDetailsTime: PROC [n: MakeDo.Node] RETURNS [created: MakeDo.Time] = {created ← GetBehaviorClassStuffTime[n, Details]};
GetBehaviorClassPrivateTime: PROC [n: MakeDo.Node] RETURNS [created: MakeDo.Time] = {created ← GetBehaviorClassStuffTime[n, Private]};
GetBehaviorClassStuffTime:
PROC [n: MakeDo.Node, stuff: Stuff]
RETURNS [created: MakeDo.Time] = {
class: BehaviorClass ← GetStuffNodeBehaviorClass[n, stuff];
created ←
IF class =
NIL
THEN MakeDo.notExistTime
ELSE
SELECT stuff
FROM
Details => IF class.detailsTime = BasicTime.nullGMT THEN MakeDo.notExistTime ELSE class.detailsTime,
Private => IF class.privateTime = BasicTime.nullGMT THEN MakeDo.notExistTime ELSE class.privateTime,
ENDCASE => ERROR;
};
FindStuffMaker:
PROC [resultName:
ROPE, finderData:
REF
ANY]
RETURNS [found:
BOOLEAN, sought: MakeDo.Node, makes, cmdFrom: MakeDo.NodeList, from: MakeDo.From, cmd:
ROPE, class: MakeDo.ActionClass, foundData:
REF
ANY] = {
stuffRef: REF Stuff = NARROW[finderData];
stuff: Stuff = stuffRef^;
resultNameLength: INT = resultName.Length[];
postfixStart: INT = resultNameLength - stuffPostfixLengths[stuff];
behaviorClassName, bcdName: ROPE;
behaviorClass: BehaviorClass;
bcdNode: MakeDo.Node;
found ← postfixStart > 0 AND resultName.Substr[start: postfixStart].Equal[stuffPostfixes[stuff]];
IF NOT found THEN RETURN;
behaviorClassName ← resultName.Substr[len: postfixStart];
behaviorClass ← RoseBindPrivate.Fetch[behaviorClassName];
IF Inhibit[behaviorClass, stuff] THEN {found ← FALSE; RETURN};
sought ← GetBehaviorClassStuffNodeByName[behaviorClassName, stuff];
makes ← LIST[sought];
cmdFrom ← NIL;
bcdNode ← MakeDo.GetNode[
behaviorClassName.Cat[pgmPostfixes[stuff], ".BCD"],
MakeDo.fileClass];
bcdName ← bcdNode.PublicPartsOfNode[].name;
from ← [mustHave: LIST[bcdNode], optional: NIL];
cmd ← Rope.Cat["Run ", bcdName];
class ← stuffMakerClasses[stuff];
foundData ←
NEW [StuffMakerRep ← [
behaviorClassName: behaviorClassName,
stuff: stuff,
bcdName: bcdName,
bcdNode: bcdNode
]];
};
Inhibit:
PROC [bc: BehaviorClass, stuff: Stuff]
RETURNS [inh:
BOOL] = {
IF bc = NIL THEN RETURN [FALSE];
inh ←
SELECT stuff
FROM
Details => bc.unusualDerivation.details,
Private => bc.unusualDerivation.private,
ENDCASE => ERROR;
};
pgmPostfixes:
ARRAY Stuff
OF
ROPE = [
Details: "RoseDetails",
Private: "RosePrivate"];
stuffMakerClasses:
ARRAY Stuff
OF MakeDo.ActionClass ← [
Details:
NEW [MakeDo.ActionClassRep ← [
CheckConsistency: CheckStuffConsistency,
Rederive: RederiveStuffMaker,
classData: NEW [Stuff ← Details]
]],
Private:
NEW [MakeDo.ActionClassRep ← [
CheckConsistency: CheckStuffConsistency,
Rederive: RederiveStuffMaker,
classData: NEW [Stuff ← Private]
]]
];
StuffMaker: TYPE = REF StuffMakerRep;
StuffMakerRep:
TYPE =
RECORD [
behaviorClassName: ROPE,
stuff: Stuff,
bcdName: ROPE,
bcdNode: MakeDo.Node
];
CheckStuffConsistency:
PROC [a: MakeDo.Action, result: MakeDo.Node]
RETURNS [consistent:
BOOL, reason:
ROPE] = {
dm: StuffMaker = NARROW[a.PublicPartsOfAction[].foundData];
stuff: Stuff = dm.stuff;
class: BehaviorClass = GetStuffNodeBehaviorClass[result, stuff];
bcdStamp: RoseBindPrivate.VersionStamp = GetBCDStamp[dm.bcdNode];
stuffStamp: RoseBindPrivate.VersionStamp =
IF class #
NIL
THEN
SELECT stuff
FROM
Details => class.detailsStamp,
Private => class.privateStamp,
ENDCASE => ERROR
ELSE RoseBindPrivate.NullVersionStamp;
IF Inhibit[class, stuff] THEN RETURN [TRUE, "has unusual derivation"];
IF bcdStamp = RoseBindPrivate.NullVersionStamp THEN RETURN [TRUE, dm.bcdName.Cat[" doesn't exist"]];
IF bcdStamp # stuffStamp
THEN
RETURN [
FALSE,
IO.PutFR[
"Current %g are %g, but latest %g is %g",
[rope[stuffNames[stuff]]],
[rope[FmtStamp[stuffStamp]]],
[rope[dm.bcdName]],
[rope[FmtStamp[bcdStamp]]]
]
];
RETURN [
TRUE,
IO.PutFR[
"Version stamps match (%g)",
[rope[FmtStamp[bcdStamp]]]
]
];
};
stuffNames:
ARRAY Stuff
OF
ROPE = [
Details: "details",
Private: "privates"];
RederiveStuffMaker:
PROC [a: MakeDo.Action]
RETURNS [from: MakeDo.From, cmd:
ROPE] = {
dm: StuffMaker = NARROW[a.PublicPartsOfAction[].foundData];
bc: BehaviorClass = RoseBindPrivate.Fetch[dm.behaviorClassName];
IF Inhibit[bc, dm.stuff] THEN RETURN [[NIL, NIL], "-- gave up"];
from ← [mustHave: LIST[dm.bcdNode], optional: NIL];
cmd ← Rope.Cat["Run ", dm.bcdName];
};
StampRef:
TYPE =
REF StampRep; StampRep:
TYPE =
RECORD [
created: BasicTime.GMT,
stamp: TimeStamp.Stamp];
GetBCDStamp:
ENTRY
PROC [node: MakeDo.Node]
RETURNS [stamp: TimeStamp.Stamp] =
BEGIN
ENABLE UNWIND => {};
sr: StampRef ← NARROW[node.GetProp[$Stamp]];
created: BasicTime.GMT ← MakeDo.InnerGetCreated[node];
bcd: ListerUtils.RefBCD;
IF sr =
NIL
THEN node.SetProp[
prop: $Stamp,
val: sr ←
NEW [StampRep ← [
created: MakeDo.notExistTime,
stamp: TimeStamp.Null]]
];
IF created = sr.created THEN RETURN [sr.stamp];
sr.created ← created;
IF created = MakeDo.notExistTime
THEN sr.stamp ← TimeStamp.Null
ELSE {
TRUSTED {bcd ← ListerUtils.ReadBcd[node.PublicPartsOfNode[].name !FS.Error => {bcd ← NIL; CONTINUE}]};
sr.stamp ←
IF bcd =
NIL
OR bcd.versionIdent # BcdDefs.VersionID
THEN TimeStamp.Null
ELSE bcd.version;
};
stamp ← sr.stamp;
END;
FmtStamp:
PROC [ts: TimeStamp.Stamp]
RETURNS [rope:
ROPE] = {
out: IO.STREAM ← IO.ROS[];
TRUSTED {ListerUtils.PrintVersion[ts, out, FALSE]};
rope ← out.RopeFromROS[];
};
GetBehaviorClassPWPNode:
PUBLIC
PROC [bc: BehaviorClass]
RETURNS [MakeDo.Node] =
{RETURN[GetPWPNode[bc.name]]};
GetPWPNode:
PROC [bcName:
ROPE]
RETURNS [n: MakeDo.Node] = {
n ← MakeDo.GetNode[bcName.Cat[pwpPostfix], pwpNodeClass];
};
GetPWPNodeClass:
PROC [n: MakeDo.Node]
RETURNS [bc: BehaviorClass] = {
nodeName: ROPE = NARROW[n.PublicPartsOfNode[].name];
className: ROPE = nodeName.Substr[len: nodeName.Length[] - pwpPostfixLength];
bc ← RoseBindPrivate.Fetch[className];
};
pwpPostfix: ROPE = " RoseBcPwp";
pwpPostfixLength: INT = pwpPostfix.Length[];
pwpNodeClass: MakeDo.NodeClass ← MakeDo.DeclareNodeClass[
name: "Rosemary Behavior Class Public Wire Prototype",
CanonizeName: RopeID,
GetTime: GetPWPTime];
RopeID:
PROC [ri:
ROPE]
RETURNS [ro:
ROPE] =
{ro ← ri};
GetPWPTime:
PROC [n: MakeDo.Node]
RETURNS [created: MakeDo.Time] = {
class: BehaviorClass ← GetPWPNodeClass[n];
created ← IF class # NIL AND class.pwpTime # BasicTime.nullGMT THEN class.pwpTime ELSE MakeDo.notExistTime;
};
GendPgmPostfixesLengths:
ARRAY Gend
OF
INT = [
Defs: RoseTranslate.GendPgmPostfixes[Defs].Length[],
Private: RoseTranslate.GendPgmPostfixes[Private].Length[]
];
GetGend:
PROC [moduleNameRoot:
ROPE, gend: Gend]
RETURNS [n: MakeDo.Node] = {
n ← MakeDo.GetNode[
moduleNameRoot.Cat[RoseTranslate.GendPgmPostfixes[gend], ".Mesa"],
MakeDo.fileClass];
};
FindTranslation:
PROC [resultName:
ROPE, finderData:
REF
ANY]
RETURNS [found:
BOOLEAN, sought: MakeDo.Node, makes, cmdFrom: MakeDo.NodeList, from: MakeDo.From, cmd:
ROPE, class: MakeDo.ActionClass, foundData:
REF
ANY] = {
fullResult, resultBase, resultExt, moduleNameRoot: ROPE;
resultCPs: FS.ComponentPositions;
resultBaseLength: INT;
gend: Gend;
moduleRoot: ModuleRoot;
resultNodes: ARRAY Gend OF MakeDo.Node;
tn: Translation;
found ← TRUE;
[fullResult, resultCPs] ← FS.ExpandName[resultName !FS.Error => {found ← FALSE; CONTINUE}];
IF NOT found THEN RETURN;
resultBase ← fullResult.Substr[start: resultCPs.base.start, len: resultCPs.base.length];
resultExt ← fullResult.Substr[start: resultCPs.ext.start, len: resultCPs.ext.length];
found ← resultExt.Equal["mesa", FALSE];
IF NOT found THEN RETURN;
found ← FALSE;
resultBaseLength ← resultBase.Length[];
FOR g: Gend
IN Gend
WHILE
NOT found
DO
postfixStart: INT = resultBaseLength - GendPgmPostfixesLengths[g];
IF postfixStart>0
AND resultBase.Substr[start: postfixStart].Equal[RoseTranslate.GendPgmPostfixes[g],
FALSE]
THEN {
found ← TRUE;
moduleNameRoot ← resultBase.Substr[len: postfixStart];
gend ← g;
};
ENDLOOP;
IF NOT found THEN RETURN;
moduleRoot ← RoseBindPrivate.EnsureModuleRoot[moduleNameRoot];
makes ← NIL;
FOR g: Gend
IN Gend
DO
resultNodes[g] ← GetGend[moduleNameRoot, g];
makes ← CONS[resultNodes[g], makes];
ENDLOOP;
sought ← resultNodes[gend];
cmd ← RoseTranslate.GetTranslateCommand[moduleNameRoot];
class ← translateClass;
foundData ← tn ←
NEW [TranslationRep ← [
mr: moduleRoot,
mrNode: GetModuleRootNode[moduleRoot],
cmd: cmd,
makes: resultNodes
]];
cmdFrom ← LIST[tn.mrNode];
from ← CalcFrom[tn];
};
CalcFrom:
PROC [tn: Translation]
RETURNS [from: MakeDo.From] = {
NoteClass:
PROC [bc: BehaviorClass] = {
pwpNode: MakeDo.Node ← GetPWPNode[bc.name];
from.mustHave ← CONS[pwpNode, from.mustHave];
};
from ← [mustHave: LIST[tn.mrNode, translatorNode], optional: NIL];
tn.mr.EnumerateModuleClasses[NoteClass];
};
translateClass: MakeDo.ActionClass ←
NEW [MakeDo.ActionClassRep ← [
CheckConsistency: CheckTranslationConsistency,
Rederive: RederiveTranslation
]];
Translation: TYPE = REF TranslationRep;
TranslationRep:
TYPE =
RECORD [
mr: ModuleRoot,
mrNode: MakeDo.Node,
cmd: ROPE,
makes: ARRAY Gend OF MakeDo.Node
];
CheckTranslationConsistency:
PROC [a: MakeDo.Action, result: MakeDo.Node]
RETURNS [consistent:
BOOL, reason:
ROPE] = {
t: Translation = NARROW[a.PublicPartsOfAction[].foundData];
g: Gend =
SELECT result
FROM
t.makes[Defs] => Defs,
t.makes[Private] => Private,
ENDCASE => ERROR;
numStamps: NAT ← 0;
PerStamp:
PROC [behaviorClassName:
ROPE, typeString: RoseTranslate.TypeString] = {
bc: BehaviorClass = RoseBindPrivate.Fetch[behaviorClassName];
curTS: RoseTranslate.TypeString;
diff: ROPE;
numStamps ← numStamps + 1;
IF reason # NIL THEN RETURN;
IF bc =
NIL
OR t.mr.classes.Lookup[bc] # bc
THEN {
consistent ← FALSE;
reason ← Rope.Cat[
"generated code handles extraneous behavior class ",
behaviorClassName
];
RETURN
};
curTS ← RoseTranslate.TypeStringFromClass[bc];
diff ← RoseTranslate.CompareTypeStrings[curTS, typeString];
IF diff #
NIL
THEN {
consistent ← FALSE;
reason ← Rope.Cat[
"current public wire prototype of behavior class ",
behaviorClassName,
" different from that used in generation of existing code: ",
diff];
};
};
genTranslatorStamp: ROPE;
consistent ← TRUE;
reason ← NIL;
genTranslatorStamp ← RoseTranslate.EnumerateGeneratedStamps[t.mr, g, PerStamp];
IF reason # NIL THEN RETURN;
IF genTranslatorStamp = NIL THEN RETURN [FALSE, "no generated code around"];
IF numStamps < t.mr.classes.Size[]
THEN
RETURN [
FALSE,
IO.PutFR[
"Generated code misses %g behavior classes",
[integer[t.mr.classes.Size[] - numStamps]]
]
];
IF
NOT genTranslatorStamp.Equal[RoseTranslate.translatorVersion]
THEN
RETURN [
FALSE,
IO.PutFR[
"generated by different version (%g) of translator than current (%g)",
[rope[genTranslatorStamp]],
[rope[RoseTranslate.translatorVersion]]
]];
RETURN [TRUE, "existing code generated from equivalent behavior class public wire prototypes"];
};
RederiveTranslation:
PROC [a: MakeDo.Action]
RETURNS [from: MakeDo.From, cmd:
ROPE] = {
t: Translation = NARROW[a.PublicPartsOfAction[].foundData];
from ← CalcFrom[t];
cmd ← t.cmd;
};
translatorClass: MakeDo.NodeClass = MakeDo.DeclareNodeClass[
name: "Rosemary Translator",
CanonizeName: RopeID,
GetTime: GetTranslatorTime
];
GetTranslatorTime:
PROC [n: MakeDo.Node]
RETURNS [created: BasicTime.
GMT]
--MakeDo.GetTimeProc-- = {
created ← RoseTranslate.translatorTime;
};
translatorNode: MakeDo.Node = MakeDo.GetNode["Rosemary Translator", translatorClass];
moduleRootClass: MakeDo.NodeClass = MakeDo.DeclareNodeClass[
name: "Rosemary Module Roots",
CanonizeName: RopeID,
GetTime: GetModuleRootTime
];
moduleRootPostfix: ROPE = " RoseModRoot";
moduleRootPostfixLength: INT = moduleRootPostfix.Length[];
GetModuleRootTime:
PROC [n: MakeDo.Node]
RETURNS [created: BasicTime.
GMT] = {
nodeName: ROPE = n.PublicPartsOfNode[].name;
nodeNameLength: INT = nodeName.Length[];
moduleRootName: ROPE = nodeName.Substr[len: nodeNameLength - moduleRootPostfixLength];
moduleRoot: RoseBindPrivate.ModuleRoot = RoseBindPrivate.EnsureModuleRoot[moduleRootName];
created ← moduleRoot.lastUpdate;
};
GetModuleRootNode
: PUBLIC PROC [mr: RoseBindPrivate.ModuleRoot] RETURNS [mrn: MakeDo.Node]
= {mrn ← GetModuleRootNodeByName[mr.name]};
GetModuleRootNodeByName:
PROC [moduleNameRoot:
ROPE]
RETURNS [mrn: MakeDo.Node] = {
mrn ← MakeDo.GetNode[someName: moduleNameRoot.Concat[moduleRootPostfix], class: moduleRootClass];
};
MakeDo.AddFinder[
[
name: "Rosemary Behavior Class Details Maker Finder",
finderProc: FindStuffMaker,
finderData: NEW [Stuff ← Details]],
back];
MakeDo.AddFinder[
[
name: "Rosemary Behavior Class Private Maker Finder",
finderProc: FindStuffMaker,
finderData: NEW [Stuff ← Private]],
back];
MakeDo.AddFinder[
[
name: "Rosemary Translator Finder",
finderProc: FindTranslation
],
back];
END.