
<<RoseTranslateDefs.Mesa>>
<<Spreitzer, October 1, 1985 6:20:25 pm PDT >>
    <<Barth, September 10, 1985 8:26:25 pm PDT>>

    DIRECTORY BasicTime, Commander, Core, CoreOps, FS, IO, PutGet, Rope, RoseBind, RoseBindPrivate, RoseBehavior, RoseTranslate, 
    RoseTranslatePrivate, RoseWireTypes, RoseWireTypeUse, TEditMesaOps, TextEdit, TextNode, TiogaAccess, TiogaFileOps, 
    TiogaStreams, UserCredentials;

    RoseTranslateDefs: CEDAR PROGRAM
        IMPORTS BasicTime, FS, IO, PutGet, Rope, RoseBindPrivate, 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;
        ppDecl: ROPE _ NIL;
        ListName: PROC [name: ROPE, pp: RoseBehavior.PortPath] = {
            IF ppDecl # NIL THEN ppDecl _ ppDecl.Cat[", "];
            ppDecl _ ppDecl.Cat[name];
            };
        PerClass: PROC [bc: BehaviorClass] = {
            [] _ RoseBindPrivate.EnsureBCParts[bc, FALSE, FALSE, TRUE];
            bc _ bc;
            FOR wf: WireFlavor IN WireFlavor DO
                rwc: RoseWireClass _ bc.wiring[wf];
                user.AddRWCAux[rwc];
                ENDLOOP;
            bc _ bc;
            ForEachPortPath[bc, ListName];
            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 = {"];
        Break[1];
        PutRope["\n"];
        IF ppDecl # NIL THEN ppDecl _ ppDecl.Cat[": RoseBehavior.PortPath;"];
        PutRope[RoseWireTypeUse.StmtCat[repAux, ppDecl]];
        Break[0];
        PutRope["}."];
        Break[-1];
        w.WriteFile[fileName];
        };

    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;
        DefinePP: PROC [name: ROPE, pp: RoseBehavior.PortPath] = {
            first: BOOL _ TRUE;
            Break[0];
            PutF["%g: PUBLIC RoseBehavior.PortPath _ LIST[", [rope[name]] ];
            FOR pp _ pp, pp.rest WHILE pp # NIL DO
                IF first THEN first _ FALSE ELSE PutRope[", "];
                PutF["%g", [cardinal[pp.first]] ];
                ENDLOOP;
            PutRope["];"];
            Break[0];
            };
        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[0];
            ForEachPortPath[bc, DefinePP];
            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]];
        user.NoteModuleRefs[Export, 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];
        };

    ForEachPortPath: PROC [bc: BehaviorClass, Do: PROC [ROPE, RoseBehavior.PortPath]] = {
        Work: PROC [w: Core.Wire, name: ROPE, prefix: RoseBehavior.PortPath] = {
            IF prefix # NIL THEN Do[name, prefix];
            IF w.structure = atom THEN RETURN;
            FOR i: NAT IN [0 .. w.elements.size) DO
                sw: Core.Wire _ w.elements[i];
                path: RoseBehavior.PortPath _ Append[prefix, i];
                Work[sw, name.Concat[sw.name], path];
                ENDLOOP;
            w _ w;
            };
        Work[bc.publicWirePrototype, bc.name, NIL];
        };

    Append: PROC [pp: RoseBehavior.PortPath, i: CARDINAL] RETURNS [longer: RoseBehavior.PortPath] = {
        IF pp = NIL THEN RETURN [LIST[i]];
        longer _ CONS[pp.first, Append[pp.rest, i]];
        };

    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;
        
        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, 
        IF node = NIL THEN RETURN;
        IF 
        IF NOT node.NodeRope[].Equal[fileName] THEN RETURN;
        [node, 
        IF 
        in _ IO.RIS[node.NodeRope[]];
        IF NOT Consume[versionIntro] THEN RETURN;
        gotStamp _ in.GetLineRope[];
        in.Close[];
        [node, 
        IF 
        IF NOT node.NodeRope[].Equal[stampsIntro] THEN RETURN;
        DO
            stamp
            end
            behaviorClassName: ROPE;
            typeString: TypeString;
            [node, 
            IF 
            IF 
            behaviorClassName _ node.NodeRope[];
            [node, 
            IF 
            typeString _ node.NodeRope[];
            to[behaviorClassName, typeString];
            first _ FALSE;
            ENDLOOP;
        translatorStamp _ gotStamp;
        };

    END.