~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
SummonerLoadData:
TYPE ~
RECORD [
summonerInstallFile, summonerInstallRoot: ROPE
];
summonerLoadClass: MakeDo.ActionClass ←
NEW[MakeDo.ActionClassRep ← [
CheckConsistency: CheckSummonerLoadConsistency,
Rederive: RederiveSummonerLoad
]];
SummonerLoadFind: MakeDo.FinderProc = {
[resultName: ROPE, finderData: REF ANY] RETURNS [found: BOOLEAN, sought: MakeDo.Node, makes: MakeDo.NodeList, cmdFrom: MakeDo.NodeList, from: MakeDo.From, cmd: ROPE, class: MakeDo.ActionClass, foundData: REF ANY]
summonerLoadData: REF SummonerLoadData;
summonerInstallName: ROPE;
cp: FS.ComponentPositions;
IF ~ Rope.Match[pattern: "*.summonerLoad", object: resultName, case: FALSE] THEN GOTO Fail; --This is all we know how to build
[resultName, cp,] ← FS.ExpandName[name: resultName ! FS.Error => GOTO Fail];
summonerInstallName ← WithoutVersion[FS.FileInfo[name: Rope.Substr[base: resultName, len: cp.base.start+cp.base.length].Concat[".summonerInstall"] ! FS.Error => GOTO Fail].fullFName];
foundData ← summonerLoadData ←
NEW[SummonerLoadData ← [
summonerInstallFile: summonerInstallName,
summonerInstallRoot: Rope.Substr[base: resultName, start: cp.base.start, len: cp.base.length]
]];
from ← DeriveFrom[summonerLoadData];
cmdFrom ← LIST[MakeDo.GetNode[someName: summonerInstallName, class: MakeDo.fileClass]];
makes ← LIST[sought ← MakeDo.GetNode[someName: resultName, class: MakeDo.fileClass]];
cmd ← DeriveCmd[summonerLoadData];
class ← summonerLoadClass;
found ← TRUE;
EXITS Fail => {
found ← FALSE;
sought ← NIL;
};
};
WithoutVersion:
PROC [with:
ROPE]
RETURNS [without:
ROPE] ~ {
cp: FS.ComponentPositions;
[fullFName: without, cp: cp] ← FS.ExpandName[name: with];
without ← Rope.Substr[base: without, len: cp.ext.start+cp.ext.length];
};
DeriveCmd:
PROC [summonerLoadData:
REF SummonerLoadData]
RETURNS [cmd:
ROPE] ~ {
RETURN [Rope.Cat["RederiveSummonerLoad ", summonerLoadData.summonerInstallRoot]];
};
DeriveFrom:
PROC [summonerLoadData:
REF SummonerLoadData]
RETURNS [from: MakeDo.From] ~ {
PutFilesInFromList: SymTab.EachPairAction = {
[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]
from.mustHave ← CONS[MakeDo.GetNode[someName: key, class: MakeDo.fileClass], from.mustHave];
RETURN [FALSE]
};
Install:
PROC [module, file:
ROPE] ~ {
[] ← SymTab.Store[x: x, key: file, val: NIL];
from.mustHave ← CONS[MakeDo.GetNode[someName: file, class: MakeDo.fileClass], from.mustHave];
};
s: IO.STREAM ← FS.StreamOpen[fileName: summonerLoadData.summonerInstallFile];
x: SymTab.Ref ~ SymTab.Create[case: FALSE];
from ← [mustHave: LIST[MakeDo.GetNode[someName: FS.ExpandName[name: summonerLoadData.summonerInstallFile].fullFName, class: MakeDo.fileClass]], optional: NIL];
RecurseThroughInstall[file: summonerLoadData.summonerInstallFile, install: Install, run: NIL, other: NIL, recurseVMap: FALSE ! CantFind => {Install[module: module, file: FileNames.GetShortName[path: full]]; RESUME}];
[] ← SymTab.Pairs[x: x, action: PutFilesInFromList];
};
ForceConsistencyReturn: ERROR [setConsistent: BOOL, setReason: ROPE] ~ CODE;
CheckSummonerLoadConsistency: MakeDo.ConsistencyChecker = {
[a: MakeDo.Action, result: MakeDo.Node] RETURNS [consistent: BOOL, reason: ROPE]
PerIngredient:
PROC [n: MakeDo.Node, which: MakeDo.ActionDep, optional:
BOOL] ~ {
nodeTime: BasicTime.GMT ← MakeDo.InnerGetCreated[n];
nodeName: ROPE ~ MakeDo.PublicPartsOfNode[n: n].name;
SELECT
TRUE
FROM
nodeTime = MakeDo.notExistTime => {
IF ~optional THEN ERROR ForceConsistencyReturn[setConsistent: TRUE, setReason: IO.PutFR[format: "ingredient %g doesn't exist", v1: [rope[nodeName]]]];
};
resultTime = MakeDo.notExistTime => {}; --More important than anything below
BasicTime.Period[from: nodeTime, to: resultTime] < 0 => ERROR ForceConsistencyReturn[setConsistent: FALSE, setReason: IO.PutFR[format: "result %g (of %g) predates ingredient %g (of %g)", v1: [rope[resultName]], v2: [time[resultTime]], v3: [rope[nodeName]], v4: [time[nodeTime]]]]
ENDCASE;
};
summonerLoadData: REF SummonerLoadData ~ NARROW[MakeDo.PublicPartsOfAction[a].foundData];
resultTime: MakeDo.Time = result.InnerGetCreated[];
resultName: ROPE = MakeDo.PublicPartsOfNode[n: result].name;
MakeDo.InnerEnumerateSources[a: a, which: data, to: PerIngredient ! ForceConsistencyReturn => {
consistent ← setConsistent;
reason ← setReason;
GOTO Exit;
}];
IF resultTime = MakeDo.notExistTime THEN RETURN [consistent: FALSE, reason: IO.PutFR[format: "result %g doesn't exist", v1: [rope[resultName]]]]
ELSE RETURN [consistent: TRUE, reason: "result dated later than any ingredient"];
EXITS Exit => {};
};
RederiveSummonerLoad: MakeDo.RederiveProc = {
[a: MakeDo.Action] RETURNS [from: MakeDo.From, cmd: ROPE]
summonerLoadData: REF SummonerLoadData ~ NARROW[MakeDo.PublicPartsOfAction[a].foundData];
from ← DeriveFrom[summonerLoadData];
cmd ← DeriveCmd[summonerLoadData];
};
CantFind: SIGNAL [module, full: ROPE] ~ CODE; --Called by RecurseThroughInstall when it has to resort to a version map
RecurseThroughInstall:
PROC [file:
ROPE, install:
PROC [module, file:
ROPE], run:
PROC [package:
ROPE], other:
PROC [line:
ROPE], checkVMap, recurseVMap:
BOOL ←
TRUE] ~ {
stream: IO.STREAM ~ FS.StreamOpen[fileName: file];
DO
line: ROPE ~ IO.GetLineRope[stream ! IO.EndOfStream => EXIT];
SELECT
TRUE
FROM
Rope.Match[pattern: "
install *", object: line, case:
FALSE] => {
s: IO.STREAM ~ IO.RIS[rope: line];
word: ROPE ← IO.GetTokenRope[stream: s, breakProc: IO.IDProc].token;
DO
attemptRecurse: BOOL ← TRUE;
TryLocalDirectory:
PROC [name: ROPE]
RETURNS [succeeded:
BOOL] ~ {
file ← FS.FileInfo[name: name ! FS.Error => {file ← NIL; CONTINUE}].fullFName;
RETURN [file#NIL]
};
TryVersionMap:
PROC [name:
ROPE]
RETURNS [succeeded:
BOOL] ~ {
IF ~checkVMap THEN RETURN [FALSE]
ELSE {
map: VersionMap.MapList ~ VersionMapDefaults.GetMapList[which: $Source];
manl: VersionMap.MapAndNameList ~ VersionMap.ShortNameToNames[list: map, shortName: name];
FOR each: VersionMap.MapAndNameList ← manl, each.rest
UNTIL each=
NIL
DO
file ← FS.FileInfo[name: each.first.name ! FS.Error => LOOP].fullFName;
SIGNAL CantFind[word, each.first.name];
attemptRecurse ← recurseVMap;
RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
};
};
file: ROPE;
word ← IO.GetTokenRope[stream: s, breakProc: IO.IDProc ! IO.EndOfStream => EXIT].token;
SELECT
TRUE
FROM
TryLocalDirectory[Rope.Cat[word, ".load"]] => {};
TryLocalDirectory[Rope.Cat["Load", word, ".cm"]] => {};
TryVersionMap[Rope.Cat[word, ".load"]] => {};
TryVersionMap[Rope.Cat["Load", word, ".cm"]] => {};
ENDCASE => {
short: ROPE ~ Rope.Cat[word, ".load"];
SIGNAL CantFind[module: word, full: FS.ExpandName[short].fullFName];
};
IF ~ Rope.Fetch[base: word]='- AND install#NIL THEN install[module: word, file: file];
IF file#NIL AND attemptRecurse THEN RecurseThroughInstall[file: file, install: install, run: run, other: other, checkVMap: checkVMap, recurseVMap: recurseVMap];
ENDLOOP;
};
Rope.Match[pattern: "
run *", object: line, case:
FALSE] => {
s: IO.STREAM ~ IO.RIS[rope: line];
word: ROPE ← IO.GetTokenRope[stream: s, breakProc: IO.IDProc].token;
DO
word ← IO.GetTokenRope[stream: s, breakProc: IO.IDProc ! IO.EndOfStream => EXIT].token;
IF ~ Rope.Fetch[base: word]='- AND run#NIL THEN run[word];
ENDLOOP;
};
ENDCASE => {
IF line.Length[] > 0 AND other#NIL THEN other[line];
};
ENDLOOP;
};
RederiveSummonerLoadCmd: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
args: CommandTool.ArgumentVector ~ CommandTool.Parse[cmd: cmd, starExpand: TRUE];
FOR k:
NAT
IN [1..args.argc)
DO
BuildGFI:
PROC [loadName:
ROPE] ~ {
stream: IO.STREAM;
stream ← FS.StreamOpen[fileName: loadName ! FS.Error => GOTO Exit];
DO
line: ROPE ~ IO.GetLineRope[stream ! IO.EndOfStream => EXIT];
IF Rope.Match[pattern: "* (*)*", object: line]
THEN {
module: ROPE ~ Rope.Substr[base: line, len: Rope.Find[s1: line, s2: " "]];
number: ROPE ← Rope.Substr[base: line, start: Rope.Find[s1: line, s2: "("]+1];
value: NAT;
number ← Rope.Substr[base: number, len: Rope.Find[s1: number, s2: ")"]];
value ← Convert.CardFromRope[r: number ! Convert.Error => LOOP];
[] ← SymTab.Store[x: gfi, key: module, val: NEW[NAT ← value]];
};
ENDLOOP;
EXITS Exit => {};
};
EachPackageName: SymTab.EachPairAction = {
[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]
RETURN [FALSE]
};
Other:
PROC [line:
ROPE] ~ {
s: IO.STREAM ~ IO.RIS[line];
[] ← IO.SkipWhitespace[stream: s];
IF ~
IO.EndOf[s]
THEN {
IO.PutF[stream: cmd.out, format: "%lUnrecognized line: \"%g\".", v1: [rope["i"]], v2: [rope[line]], v3: [rope[" "]]];
result ← $Failure;
};
};
Run:
PROC [package:
ROPE] ~ {
EstimatedGFIs:
PROC [module:
ROPE]
RETURNS [gfis:
NAT ← 1] ~ {
ref: REF;
IF (ref ← (SymTab.Fetch[x: gfi, key: module].val)) # NIL THEN gfis ← NARROW[ref, REF NAT]^;
};
IF SymTab.Fetch[x: x, key: package].found THEN RETURN; --Don't run a package more than once
IO.PutF[stream: s, format: "%g (%g)\n", v1: [rope[package]], v2: [cardinal[EstimatedGFIs[package]]]];
[] ← SymTab.Store[x: x, key: package, val: NIL];
};
x: SymTab.Ref ~ SymTab.Create[case: FALSE]; --Packages listed in the file
y: SymTab.Ref ~ SymTab.Create[case: FALSE]; --Version Map warnings
gfi: SymTab.Ref ~ SymTab.Create[case: FALSE]; --Version Map warnings
s: IO.STREAM;
loadName: ROPE ~ Rope.Cat[args[k], ".summonerLoad"];
fileName: ROPE ~ FS.ExpandName[name: Rope.Cat[args[k], ".summonerInstall"] ! FS.Error => {msg ← IO.PutFR[format: "Could not find %g.summonerInstall.\n", v1: [rope[args[k]]]]; EXIT}].fullFName;
BuildGFI[loadName];
s ← FS.StreamOpen[fileName: loadName, accessOptions: create];
IO.PutF[stream: s, format: "-- %g\n-- Copyright 1986 by Xerox Corporation. All rights reserved.\n\n", v1: [rope[Rope.Cat[args[k], ".summonerLoad"]]]];
{
ENABLE {
CantFind => {
IF SymTab.Fetch[x: y, key: full].found THEN RESUME;
IO.PutF[stream: cmd.out, format: "%lNeed \"%g\".%l\n", v1: [rope["i"]], v2: [rope[full]], v3: [rope[" "]]];
[] ← SymTab.Store[x: y, key: full, val: NIL];
result ← $Failure; --Consider having to looking at the version map a flop
RESUME;
};
};
RecurseThroughInstall[file: fileName, install: NIL, run: Run, other: Other, recurseVMap: FALSE];
};
IO.Close[self: s];
ENDLOOP;
};
Commander.Register[key: "///Commands/RederiveSummonerLoad", proc: RederiveSummonerLoadCmd];
MakeDo.AddFinder[finder: [name: "SummonerLoad", finderProc: SummonerLoadFind], end: front];