
    <<EDIFSemanticsBasic.Mesa>>
        <<Spreitzer, February 23, 1986 5:49:08 pm PST>>

    DIRECTORY Atom, BasicTime, EDIFDataStructure, EDIFfing, EDIFGrammar, EDIFSemantics, HashTable, Rope;

    EDIFSemanticsBasic: CEDAR PROGRAM
        IMPORTS Atom, BasicTime, EDIFGrammar, EDIFSemantics, Rope
        = {OPEN EDIFfing, EDIFDataStructure, EDIFGrammar, EDIFSemantics;

        DefineEm: PROC = {
            SS[DL[$EDIF, LIST[NameDef[], $Status, Star[$Keyword], Opt[$Rename], StarCh[LIST[$Design, $External, $Library, $Comment, $UserData]] 
            ]],
                [BeforeEDIF, AfterEDIF, SeeEDIFField]];
            SS[DL[$Status, LIST[Opt[$EDIFVersion], Opt[$EDIFLevel], StarCh[LIST[$Written, $Comment, $UserData]] ]],
                [BeforeStatus, AfterStatus]];
            SS[DL[$EDIFVersion, LIST[$Integer, $Integer, $Integer]],
                [NIL, NIL, SeeVersionField]];
            SS[DL[$EDIFLevel, LIST[$EDIFLevelName]],
                [NIL, NIL, SeeLevel]];
            [] _ DC[$EDIFLevelName, LIST[NEW[INT _ 0], NEW[INT _ 1], NEW[INT _ 2]]];
            SS[DL[$Written, LIST[$TimeStamp, StarCh[LIST[$Accounting, $Comment, $UserData]] ]],
                [BeforeWritten, AfterWritten]];
            SS[DL[$TimeStamp, LIST[$Integer, $Integer, $Integer, $Integer, $Integer, $Integer]],
                [BeforeTimeStamp, AfterTimeStamp, SeeTimeStampField]];
            SS[DL[$Accounting, LIST[$Identifier, Opt[$String]]],
                [BeforeAccounting, AfterAccounting, SeeAccountingField]];
            SS[DL[$Comment, LIST[Star[$String]]],
                [BeforeComment, AfterComment, SeeCommentField]];
            SS[DL[$UserData, LIST[$Identifier, Star[$Form]]],
                [BeforeUserData, AfterUserData, SeeUserDataField]];
            SS[DL[$Keyword, LIST[NameDef[], StarCh[LIST[$Formal, $Optional, $Extra, $FormalValue, $ForEach, $Comment]] ]],
                [BeforeKeyword, AfterKeyword, SeeKeywordField]];
            SS[DL[$Formal, LIST[Star[NameDef[]]]],
                [BeforeRequiredFormal, NIL, SeeAnyFormalField]];
            SS[DL[$Optional, LIST[NameDef[], $FormalValue]],
                [BeforeOptionalFormal, NIL, SeeAnyFormalField]];
            SS[DL[$Extra, LIST[Star[NameDef[]]]],
                [BeforeExtraFormal, NIL, SeeAnyFormalField]];
            [] _ DC[$FormalValue, LIST[$String, $Integer, NameRef[], $BuildName, $Build]];
            SS[DL[$BuildName, LIST[$String]],
                [BeforeBuildName, AfterBuildName, SeeBuildNameField]];
            SS[DL[$Build, LIST[$KeyRef, StarCh[LIST[$FormalValue, $ForEach, $Index, $Comment]] ]],
                [BeforeBuildList, AfterBuildList, SeeBuildListField]];
            [] _ DC[$KeyRef, LIST[$Identifier, $String]];
            SS[DL[$ForEach, LIST[$NameRefs, StarCh[LIST[$FormalValue, $ForEach, $Index, $Comment]] ]],
                [BeforeForEach, AfterForEach, SeeForEachField]];
            SS[DL[$Index, LIST[NameRef[]]],
                [BeforeIndex, AfterIndex, SeeIndexField]];
            SS[DL[$Rename, LIST[NameRef[], $String]],
                [BeforeRename, AfterRename, SeeRenameField]];
            };

        BeforeEDIF: Beforer = {
            ew: EDIFWhole = NEW [EDIFWholePrivate _ [
                status: NIL,
                designs: MakeRopeDict[],
                libraries: MakeRopeDict[],
                externalLibraries: MakeRopeDict[]
                ]];
            ewc: EDIFWholeConversion = NEW [EDIFWholeConversionPrivate _ [ew]];
            context _ ewc;
            };

        SeeEDIFField: SubResultConsumer = {
            ewc: EDIFWholeConversion = NARROW[context];
            ew: EDIFWhole = ewc.ew;
            IF index = 1 THEN {
                ew.name.edif _ Atom.GetPName[NARROW[result]];
                };
            };

        AfterEDIF: Afterer = {
            ewc: EDIFWholeConversion = NARROW[context];
            result _ ewc.ew;
            };

        BeforeStatus: Beforer = {
            s: Status = NEW [StatusPrivate _ []];
            sc: StatusConversion = NEW [StatusConversionPrivate _ [s]];
            WITH parentContext SELECT FROM
                ewc: EDIFWholeConversion => {
                    IF ewc.ew.status # NIL THEN ERROR;
                    ewc.ew.status _ s};
                lc: LibraryConversion => {
                    IF lc.l.status # NIL THEN ERROR;
                    lc.l.status _ s};
                ctgc: CellTypeGenConversion => {
                    IF ctgc.ctfe.status # NIL THEN ERROR;
                    ctgc.ctfe.status _ s};
                dc: DesignConversion => {
                    IF dc.d.status # NIL THEN ERROR;
                    dc.d.status _ s};
                vgc: ViewGenConversion => {
                    IF vgc.vg.status # NIL THEN ERROR;
                    vgc.vg.status _ s};
                ENDCASE;
            context _ sc;
            };

        AfterStatus: Afterer = {
            sc: StatusConversion = NARROW[context];
            s: Status = sc.s;
            IF s.level # unspecifiedLevel THEN SetLevel[s.level, 1];
            result _ s;
            };

        SeeVersionField: SubResultConsumer = {
            sc: StatusConversion = NARROW[parentContext];
            s: Status = sc.s;
            ri: REFINT = NARROW[result];
            SELECT index FROM
                1 => s.version.major _ ri^;
                2 => s.version.medium _ ri^;
                3 => s.version.minor _ ri^;
                ENDCASE => ResultOffTail[];
            };

        SeeLevel: SubResultConsumer = {
            sc: StatusConversion = NARROW[parentContext];
            s: Status = sc.s;
            ri: REFINT = NARROW[result];
            s.level _ ri^;
            };

        BeforeWritten: Beforer = {
            w: Written = NEW [WrittenPrivate _ []];
            wc: WrittenConversion = NEW [WrittenConversionPrivate _ [w]];
            context _ wc;
            };

        AfterWritten: Afterer = {
            sc: StatusConversion = NARROW[parentContext];
            s: Status = sc.s;
            wc: WrittenConversion = NARROW[context];
            w: Written = wc.w;
            wl: WrittenList = LIST[w];
            IF sc.wTail = NIL THEN s.writtens _ wl ELSE sc.wTail.rest _ wl;
            sc.wTail _ wl;
            result _ w;
            };

        BeforeTimeStamp: Beforer = {
            context _ NEW [BasicTime.Unpacked _ [zone: 0]];
            };

        SeeTimeStampField: SubResultConsumer = {
            tsc: TimeStampConversion = NARROW[context];
            ri: REFINT = NARROW[result];
            SELECT index FROM
                1 => tsc.year _ ri^;
                2 => tsc.month _ VAL[CARDINAL[ri^-1]];
                3 => tsc.day _ ri^;
                4 => tsc.hour _ ri^;
                5 => tsc.minute _ ri^;
                6 => tsc.second _ ri^;
                ENDCASE => ResultOffTail[];
            };

        AfterTimeStamp: Afterer = {
            wc: WrittenConversion = NARROW[parentContext];
            tsc: TimeStampConversion = NARROW[context];
            wc.w.time _ BasicTime.Pack[tsc^];
            result _ tsc;
            };

        BeforeAccounting: Beforer = {
            context _ NEW [AccountingPrivate _ [NIL]];
            };

        SeeAccountingField: SubResultConsumer = {
            a: Accounting = NARROW[context];
            SELECT index FROM
                1 => a.name _ NARROW[result];
                2 => a.data _ NARROW[result];
                ENDCASE => ResultOffTail[];
            };

        AfterAccounting: Afterer = {
            wc: WrittenConversion = NARROW[parentContext];
            a: Accounting = NARROW[context];
            al: AccountingList = LIST[a];
            IF wc.aTail = NIL THEN wc.w.accountings _ al ELSE wc.aTail.rest _ al;
            wc.aTail _ al;
            result _ a;
            };

        BeforeComment: Beforer = {
            c: Comment;
            cc: CommentConversion = NEW [CommentConversionPrivate _ [c]];
            context _ cc};

        SeeCommentField: SubResultConsumer = {
            cc: CommentConversion = NARROW[context];
            r: ROPE = NARROW[result];
            cl: Comment = LIST[r];
            IF cc.tail = NIL THEN cc.c _ cl ELSE cc.tail.rest _ cl;
            cc.tail _ cl;
            };

        AfterComment: Afterer = {
            cc: CommentConversion = NARROW[context];
            c: Comment = cc.c;
            WITH parentContext SELECT FROM
                ewc: EDIFWholeConversion => [ewc.ew.comments, ewc.cTail] _ AppendC[ewc.ew.comments, ewc.cTail, c];
                sc: StatusConversion => [sc.s.comments, sc.cTail] _ AppendC[sc.s.comments, sc.cTail, c];
                wc: WrittenConversion => [wc.w.comments, wc.cTail] _ AppendC[wc.w.comments, wc.cTail, c];
                mdc: MacroDefConversion => [mdc.md.comments, mdc.cTail] _ AppendC[mdc.md.comments, mdc.cTail, c];
                lc: LibraryConversion => [lc.l.comments, lc.cTail] _ AppendC[lc.l.comments, lc.cTail, c];
                ctgc: CellTypeGenConversion => [ctgc.ctfe.comments, ctgc.cTail] _ AppendC[ctgc.ctfe.comments, ctgc.cTail, c];
                vgc: ViewGenConversion => [vgc.vg.comments, vgc.cTail] _ AppendC[vgc.vg.comments, vgc.cTail, c];
                ENDCASE;
            result _ c;
            };

        AppendC: PROC [head, tail: Comments, x: Comment] RETURNS [
            
            IF tail = NIL THEN 
            };

        BeforeUserData: Beforer = {
            ue: UserExtension = [];
            uec: UserExtensionConversion = NEW [UserExtensionConversionPrivate _ [ue]];
            context _ uec;
            };

        SeeUserDataField: SubResultConsumer = {
            uec: UserExtensionConversion = NARROW[context];
            SELECT index FROM
                =1 => {uec.ue.name.edif _ Atom.GetPName[NARROW[result]]};
                >1 => {tail: ParseTreeList = LIST[NARROW[result]];
                    IF uec.fTail = NIL THEN uec.ue.forms _ tail ELSE uec.fTail.rest _ tail;
                    uec.fTail _ tail};
                ENDCASE => ERROR;
            };

        AfterUserData: Afterer = {
            uec: UserExtensionConversion = NARROW[context];
            ue: UserExtension = uec.ue;
            WITH parentContext SELECT FROM
                ewc: EDIFWholeConversion => [ewc.ew.ues, ewc.ueTail] _ AppendUE[ewc.ew.ues, ewc.ueTail, ue];
                sc: StatusConversion => [sc.s.ues, sc.ueTail] _ AppendUE[sc.s.ues, sc.ueTail, ue];
                wc: WrittenConversion => [wc.w.ues, wc.ueTail] _ AppendUE[wc.w.ues, wc.ueTail, ue];
                lc: LibraryConversion => [lc.l.ues, lc.ueTail] _ AppendUE[lc.l.ues, lc.ueTail, ue];
                ctgc: CellTypeGenConversion => [ctgc.ctfe.ues, ctgc.ueTail] _ AppendUE[ctgc.ctfe.ues, ctgc.ueTail, ue];
                ENDCASE;
            };

        AppendUE: PROC [head, tail: UserExtensions, x: UserExtension] RETURNS [
            
            IF tail = NIL THEN 
            };

        MacroDefConversion: TYPE = REF MacroDefConversionPrivate;
        MacroDefConversionPrivate: TYPE = RECORD [
            md: MacroDef,
            name: ATOM,
            rfTail, ofTail, efTail: IdPtList _ NIL,
            gTail: ParseTreeGeneratorList _ NIL,
            cTail: Comments
            ];

        BeforeKeyword: Beforer = {
            md: MacroDef = NEW [MacroDefPrivate _ []];
            mdc: MacroDefConversion = NEW [MacroDefConversionPrivate _ [md]];
            context _ mdc;
            };

        SeeKeywordField: SubResultConsumer = {
            mdc: MacroDefConversion = NARROW[context];
            md: MacroDef = mdc.md;
            IF index = 1 THEN {
                mdc.name _ NARROW[result];
                RETURN;
                };
            IF result = NIL THEN RETURN;
            [md.generators, mdc.gTail] _ AppendPTG[md.generators, mdc.gTail, ToPTG[result, subTree]];
            };

        ToPTG: PROC [result: REF ANY, subTree: ParseTree] RETURNS [ptg: ParseTreeGenerator] = {
            WITH result SELECT FROM
                x: ParseTreeGenerator => ptg _ x;
                x: ROPE => ptg _ MakePTG[literal, subTree, subTree];
                x: REFINT => ptg _ MakePTG[literal, subTree, subTree];
                x: ATOM => ptg _ MakePTG[name, x, subTree];
                ENDCASE => ERROR;
            };

        AppendPTG: PROC [head, tail: ParseTreeGeneratorList, x: ParseTreeGenerator] RETURNS [
            
            IF tail = NIL THEN 
            };

        AfterKeyword: Afterer = {
            mdc: MacroDefConversion = NARROW[context];
            md: MacroDef = mdc.md;
            DefineMacro[mdc.name, md];
            result _ md;
            };

        MakePTG: PROC [type: ParseTreeGeneratorType, val: REF ANY, quaPT: ParseTree] RETURNS [ptg: ParseTreeGenerator] = {
            ptg _ SELECT type FROM
                literal => NEW [ParseTreeGeneratorPrivate _ [variant: literal[NARROW[val]]]],
                name => NEW [ParseTreeGeneratorPrivate _ [variant: name[NARROW[val]]]],
                ENDCASE => ERROR;
            ptg.quaPT _ quaPT;
            };

        BeforeRequiredFormal: Beforer = {context _ $Required};
        BeforeOptionalFormal: Beforer = {context _ $Optional};
        BeforeExtraFormal: Beforer = {
            mdc: MacroDefConversion = NARROW[parentContext];
            md: MacroDef = mdc.md;
            md.okToSkipTail _ TRUE;
            context _ $Extra};

        SeeAnyFormalField: SubResultConsumer = {
            mdc: MacroDefConversion = NARROW[parentContext];
            md: MacroDef = mdc.md;
            f: ATOM = NARROW[result];
            SELECT context FROM
                $Required => [md.requiredFormals, mdc.rfTail] _ AppendIP[md.requiredFormals, mdc.rfTail, NARROW[subTree]];
                $Optional => [md.optionalFormals, mdc.ofTail] _ AppendIP[md.optionalFormals, mdc.ofTail, NARROW[subTree]];
                $Extra => [md.extraFormals, mdc.efTail] _ AppendIP[md.extraFormals, mdc.efTail, NARROW[subTree]];
                ENDCASE => ERROR;
            };

        AppendIP: PROC [head, tail: IdPtList, x: IdPt] RETURNS [
            
            IF tail = NIL THEN 
            };

        BeforeBuildName: Beforer = {
            ptg: ParseTreeGenerator = NEW [ParseTreeGeneratorPrivate _ [
                quaPT: selfTree,
                variant: name[NIL]
                ]];
            context _ ptg;
            };

        SeeBuildNameField: SubResultConsumer = {
            nptg: REF name ParseTreeGeneratorPrivate = NARROW[context];
            nptg.id _ Atom.MakeAtom[NARROW[result]];
            };

        AfterBuildName: Afterer = {result _ context};

        ListGenConversion: TYPE = REF ListGenConversionPrivate;
        ListGenConversionPrivate: TYPE = RECORD [
            ptg: ParseTreeGenerator,
            tail: ParseTreeGeneratorList _ NIL
            ];

        BeforeBuildList: Beforer = {
            ptg: ParseTreeGenerator = NEW [ParseTreeGeneratorPrivate.buildList _ [quaPT: selfTree, variant: buildList[elts: NIL]]];
            lgc: ListGenConversion = NEW [ListGenConversionPrivate _ [ptg]];
            context _ lgc};

        SeeBuildListField: SubResultConsumer = {
            lgc: ListGenConversion = NARROW[context];
            lptg: REF buildList ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
            elt: ParseTreeGenerator;
            SELECT index FROM
                =1 => {
                    WITH result SELECT FROM
                        x: ROPE => {
                            pt: ParseTree = NEW [ParseTreePrivate _ [
                                origin: subTree.origin,
                                replacing: subTree.replacing,
                                generator: subTree.generator,
                                variant: identifier[Atom.MakeAtom[x]]
                                ]];
                            elt _ MakePTG[literal, pt, subTree];
                            };
                        x: ATOM => elt _ MakePTG[literal, subTree, subTree];
                        ENDCASE => ERROR;
                    };
                #1 => {
                    elt _ ToPTG[result, subTree];
                    };
                ENDCASE => ERROR;
            [lptg.elts, lgc.tail] _ AppendPTG[lptg.elts, lgc.tail, elt];
            };

        AfterBuildList: Afterer = {
            lgc: ListGenConversion = NARROW[context];
            result _ lgc.ptg};

        BeforeForEach: Beforer = {
            ptg: ParseTreeGenerator = NEW [ParseTreeGeneratorPrivate.forEach _ [quaPT: selfTree, variant: forEach[domain: NIL, range: NIL]]];
            lgc: ListGenConversion = NEW [ListGenConversionPrivate _ [ptg]];
            context _ lgc};

        SeeForEachField: SubResultConsumer = {
            lgc: ListGenConversion = NARROW[context];
            fptg: REF forEach ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
            SELECT index FROM
                =1 => {
                    ok: BOOL _ FALSE;
                    WITH subTree SELECT FROM
                        x: REF identifier ParseTreePrivate => {
                            fptg.domain _ LIST[x.id];
                            ok _ TRUE};
                        x: REF list ParseTreePrivate => {
                            dTail: ATOMList _ NIL;
                            WITH x.children.first SELECT FROM
                                y: REF identifier ParseTreePrivate => ok _ AtomNameEq[y.id, $Multiple];
                                ENDCASE => ok _ FALSE;
                            FOR cl: ParseTreeList _ x.children.rest, cl.rest WHILE cl # NIL AND ok DO
                                WITH cl.first SELECT FROM
                                    y: REF identifier ParseTreePrivate => [fptg.domain, dTail] _ AppendA[fptg.domain, dTail, y.id];
                                    ENDCASE => ok _ FALSE;
                                ENDLOOP;
                            };
                        ENDCASE => ok _ FALSE;
                    };
                #1 => {
                    [fptg.range, lgc.tail] _ AppendPTG[fptg.range, lgc.tail, ToPTG[result, subTree]];
                    };
                ENDCASE => ERROR;
            };

        AppendA: PROC [head, tail: ATOMList, x: ATOM] RETURNS [
            
            IF tail = NIL THEN 
            };

        AfterForEach: Afterer = {
            lgc: ListGenConversion = NARROW[context];
            fptg: REF forEach ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
            result _ fptg;
            };

        BeforeIndex: Beforer = {
            context _ NEW [ParseTreeGeneratorPrivate _ [quaPT: selfTree, variant: index[NIL]]];
            };

        SeeIndexField: SubResultConsumer = {
            iptg: REF index ParseTreeGeneratorPrivate = NARROW[context];
            iptg.var _ NARROW[result];
            };

        AfterIndex: Afterer = {
            result _ context;
            };

        BeforeRename: Beforer = {
            context _ NEW [NameStuff _ []];
            };

        SeeRenameField: SubResultConsumer = {
            ns: REF NameStuff = NARROW[context];
            SELECT index FROM
                =1 => ns.edif _ Atom.GetPName[NARROW[result]];
                =2 => ns.rename _ NARROW[result];
                ENDCASE => ResultOffTail[];
            };

        AfterRename: Afterer = {
            ns: REF NameStuff = NARROW[context];
            Rename: PROC [old, delta: NameStuff] RETURNS [new: NameStuff] = {
                new _ old;
                IF RopeNameEq[new.edif, delta.edif] THEN {
                    IF new.rename = NIL THEN new.rename _ delta.rename ELSE ERROR
                    }
                ELSE ERROR;
                };
            WITH parentContext SELECT FROM
                ewc: EDIFWholeConversion => ewc.ew.name _ Rename[ewc.ew.name, ns^];
                ENDCASE;
            };

        }.