
<<SummonerLoadDepsImpl.mesa>>
    <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
    <<Eric Nickell, September 30, 1986 4:22:14 pm PDT>>
    <<Mike Spreitzer June 23, 1986 12:06:51 pm PDT>>
    <<>>
    DIRECTORY
        BasicTime, Commander, CommandTool, Convert, FileNames, FS, IO, MakeDo, Rope, SymTab, VersionMap, VersionMapDefaults;


    SummonerLoadDepsImpl: CEDAR PROGRAM
    IMPORTS BasicTime, Commander, CommandTool, Convert, FileNames, FS, IO, MakeDo, Rope, SymTab, VersionMap, VersionMapDefaults
    ~ 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];

    END.