<> <> <> <> 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 <> <<$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.