<<>>
    <<CrankTwoImpl.mesa>>
        <<Copyright Ó 1987, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, March 23, 1993 10:56 am PST>>
        <<>>
    DIRECTORY IO, CrankTypes, MPTree, MPLeaves, Rope, CrankOps, CrankAnalyze;

    CrankTwoImpl: CEDAR PROGRAM
    IMPORTS IO, Rope, CrankOps, CrankAnalyze
    EXPORTS CrankAnalyze
    ~ BEGIN OPEN CrankTypes, CrankOps;
<<Type interpretation>>
    ExternalProcType: PROC [typeGraph: TypeGraph, type: REF TypeRep.control] RETURNS [LIST OF REF] = {
        NamesFromFieldList: PROC [fieldList: FieldList] RETURNS [LIST OF REF] = {
            RETURN [IF fieldList = NIL THEN NIL ELSE CONS[fieldList.first.name, NamesFromFieldList[fieldList.rest]]]
            };
        GetFieldNames: PROC [typeCode: TypeCode] RETURNS [LIST OF REF] = {
            WITH UnderType[typeGraph, typeCode] SELECT FROM
                r: REF TypeRep.record => RETURN [NamesFromFieldList[r.fieldList]];
                ENDCASE => RETURN [NIL];
            };
        RETURN [LIST[GetFieldNames[type.argumentType], GetFieldNames[type.returnType]]]
        };

    ParameterDefaults: PROC [typeGraph: TypeGraph, type: REF TypeRep.control] RETURNS [LIST OF REF] = {
        GetDefault: PROC [tc: TypeCode] RETURNS [Tree] = {
            DO
                WITH TypeFromTypeCode[typeGraph, tc] SELECT FROM
                    t: REF TypeRep.definition => tc Ź t.groundType;
                    t: REF TypeRep.initial => RETURN [t.tree];
                    ENDCASE => RETURN [NIL];
                ENDLOOP;
            };
        DefaultsFromFieldList: PROC [fieldList: FieldList] RETURNS [LIST OF REF] = {
            RETURN [IF fieldList = NIL THEN NIL ELSE CONS[GetDefault[fieldList.first.rangeType], DefaultsFromFieldList[fieldList.rest]]]
            };
        GetFieldDefaults: PROC [typeCode: TypeCode] RETURNS [LIST OF REF] = {
            WITH UnderType[typeGraph, typeCode] SELECT FROM
                r: REF TypeRep.record => RETURN [DefaultsFromFieldList[r.fieldList]];
                ENDCASE => RETURN [NIL];
            };
        RETURN [GetFieldDefaults[type.argumentType]]
        };

    FillTypeAttributes: PUBLIC PROC [typeGraph: TypeGraph, tree: Tree] = {
        WITH tree SELECT FROM
            aNode: AttributedNode => {
                WITH GetAttribute[aNode, $TYPECODE] SELECT FROM
                    t: REF TypeCode => {
                        type: Type = TypeFromTypeCode[typeGraph, t­];
                        IF type # NIL THEN AddAttribute[aNode, $TYPE, type.ext]
                        };
                    ENDCASE => NULL;
                WITH GetAttribute[aNode, $DECLTYPECODE] SELECT FROM
                    t: REF TypeCode => {
                        type: Type = UnderType[typeGraph, t­];
                        IF type # NIL THEN { AddAttribute[aNode, $TYPECLASS, type.class] };
                        };
                    ENDCASE => NULL;
                FillTypeAttributes[typeGraph, aNode.syntaxNode];
                };
            node: REF MPTree.Node => {
                FOR i: NAT IN [1..node.sonLimit) DO
                    FillTypeAttributes[typeGraph, node.son[i]];
                    ENDLOOP;
                };
            ENDCASE => NULL;
        };

    GetTypeQualifier: PROC [context: Context, typeCode: TypeCode, shortName: ROPE] RETURNS [qualifier: ROPE Ź NIL] = {
        tc: TypeCode Ź typeCode;
        DO
            WITH TypeFromTypeCode[context.types, tc] SELECT FROM
                d: REF TypeRep.definition => {
                    IF Rope.Equal[d.shortName, shortName] THEN qualifier Ź d.qualifier;
                    tc Ź d.groundType;
                    };
                ENDCASE => EXIT;
            ENDLOOP;
        };
<<Semantic analysis>>
    AnalyzeModule: PUBLIC PROC [context: Context, tree: Tree] = {
        M: PROC [directory, imports, exports, shares, locks, decl: REF] = {
            self: AttributedNode = NARROW[tree];
            {Action: PROC [item: Tree] = {
                AddDirectoryItem[context, item];
                }; DoList[directory, Action]};
            IF shares # NIL THEN ProcessSharesList[context, shares];
            IF imports # NIL THEN ProcessModuleList[context, imports, TRUE];
            IF exports # NIL THEN ProcessModuleList[context, exports, FALSE];
            Assert[AnalyzeDecl[context, decl, self, 1]];
            Assert[AnalyzeDecl[context, decl, self, 2]];
            Assert[AnalyzeDecl[context, decl, self, 3]];
            PropagateAttribute[self, $TYPECODE, NARROW[decl], $DECLTYPECODE];
            };
        Assert[With6[tree, module, M]];
        };

    AnalyzeDecl: PUBLIC PROC [context: Context, tree: Tree, parent: AttributedNode, pass: [1..3]] RETURNS [BOOL] = {
        <<Pass 1 defines the name in the context, with a null type code.>>
        <<Pass 2 assigns the type code, but with the type graph present only in skeleton form.>>
        <<Pass 3 analyzes the value.>>
        D: PROC [idNode, typeNode, valueNode: REF] = {
            self: AttributedNode = NARROW[tree];
            Each: PROC [item: Tree] = {
                id: ROPE = GetIdentifier[item];
                SELECT pass FROM
                    1 => {
                        ste: REF SymbolTableEntryRep.other Ź NEW[SymbolTableEntryRep.other];
                        SELECT context.scopeKind FROM
                            globalDefs => ste.qualifier Ź context.moduleName;
                            globalImpl => {
                                publicType: TypeCode Ź nullTypeCode;
                                IF GetAttribute[tree, $PUBLIC] # NIL THEN [ste.qualifier, publicType] Ź FindExportee[context, id];
                                WITH UnderType[context.types, publicType] SELECT FROM
                                    t: REF TypeRep.control => AddAttribute[NARROW[typeNode], $PARAMETERDEFAULTS, ParameterDefaults[context.types, t]];
                                    ENDCASE => NULL;
                                IF publicType # nullTypeCode THEN AddTypeCodeAttribute[self, $PUBLICTYPECODE, publicType];
                                IF ste.qualifier = NIL THEN ste.qualifier Ź context.moduleName;
                                };
                            ENDCASE => NULL;
                        QualifyIdentifierNode[item, ste.qualifier];
                        ste.typeCode Ź nullTypeCode;
                        ste.readonly Ź GetAttribute[self, $CONSTANT]=$TRUE;
                        AddSymbol[context, id, ste];
                        IF context.moduleName = NIL THEN context.moduleName Ź id;
                        };
                    2 => {
                        ste: REF SymbolTableEntryRep.other Ź NARROW[LookupSymbol[context, id]];
                        ste.typeCode Ź GetTypeValueAttribute[context.types, typeNode];
                        IF context.fieldListLast # NIL THEN {
                            add: FieldList = LIST[[id, ste.typeCode]];
                            context.fieldListLast.rest Ź add;
                            context.fieldListLast Ź add;
                            };
                        };
                    ENDCASE => NULL;
                };
            IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 1], "AnalyzeTypePass(%g)", [cardinal[pass]], typeNode];
            DoList[idNode, Each];
            IF pass >= 2 THEN Assert[AnalyzeTypePass[context, typeNode, pass],"AnalyzeTypePass(%g)", [cardinal[pass]], typeNode];
            IF pass = 3 THEN {
                typeCode: TypeCode = GetTypeValueAttribute[context.types, typeNode];
                AddTypeCodeAttribute[self, $DECLTYPECODE, typeCode];
                IF valueNode # NIL THEN {
                    PropagateAttribute[valueNode, $NEEDTYPECODE, self, $DECLTYPECODE];
                    WITH UnderType[context.types, typeCode] SELECT FROM
                        c: REF TypeRep.control => {
                            IF c.class = $PROC AND GetNodeName[typeNode] # $PROCTC THEN {
                                <<Supply attributes telling the names of the arguments and results>>
                                AddAttribute[NARROW[typeNode], $PROCTYPE, ExternalProcType[context.types, c]];
                                };
                            };
                        ENDCASE => NULL;
                    CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 1];
                    CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 2];
                    CrankAnalyze.AnalyzeBodyOrExpression[context, valueNode, self, 3];
                    WITH TypeFromTypeCode[context.types, GetTypeCodeAttribute[self, $DECLTYPECODE]] SELECT FROM
                        d: REF TypeRep.record => {
                            IF d.class = $DEFINITIONS THEN {
                                <<remove the list head created by AnalyzeBodyOrExpression>>
                                IF d.fieldList = NIL OR d.fieldList.first # [NIL, nullTypeCode]
                                    THEN { Assert[FALSE, "Bug"] }
                                    ELSE { d.fieldList Ź d.fieldList.rest };
                                };
                            };
                        ENDCASE => NULL;
                    };
                };
            };
        RETURN[With3[tree, decl, D]];
        };

    AnalyzeTypeDecl: PUBLIC PROC [context: Context, tree: Tree, parent: AttributedNode, pass: [1..3]] RETURNS [BOOL] = {
        <<Pass 1 defines the name(s) in context, assigning a type code.>>
        <<Pass 2 fills in the type.>>
        <<Pass 3 analyzes the initial value.>>
        D: PROC [identifierNode, typeNode, initialValueNode: REF] = {
            self: AttributedNode = NARROW[tree];
            Each: PROC [item: Tree] = {
                id: ROPE = GetIdentifier[item];
                SELECT pass FROM
                    1 => {
                        typeCode: TypeCode = NewDefinitionType[typeGraph: context.types, qualifier: context.moduleName, shortName: id, groundType: 
                        nullTypeCode];
                        typeTypeCode: TypeCode = NewTypeType[context.types, typeCode];
                        ste: REF SymbolTableEntryRep.other = NEW[SymbolTableEntryRep.other Ź [other[typeCode: typeTypeCode, readonly: TRUE]]];
                        IF context.scopeKind = globalImpl AND GetAttribute[tree, $PUBLIC] # NIL THEN {
                            ste.qualifier Ź TryExportingType[context, id, typeCode];
                            };
                        AddSymbol[context, id, ste];
                        };
                    2 => {
                        ste: REF SymbolTableEntryRep.other = NARROW[LookupSymbol[context, id]];
                        typeType: REF TypeRep.type = NARROW[TypeFromTypeCode[context.types, ste.typeCode]];
                        type: REF TypeRep.definition = NARROW[TypeFromTypeCode[context.types, typeType.value]];
                        type.groundType Ź GetTypeValueAttribute[context.types, typeNode];
                        IF initialValueNode # NIL THEN {
                            type.groundType Ź NewInitialType[context.types, context.moduleName, initialValueNode, type.groundType];
                            };
                        IF ste.qualifier = NIL THEN {
                            ste.qualifier Ź GetTypeQualifier[context, type.typeCode, id];
                            };
                        QualifyIdentifierNode[item, ste.qualifier];
                        IF context.fieldListLast # NIL THEN {
                            add: FieldList = LIST[[id, typeType.typeCode]];
                            context.fieldListLast.rest Ź add;
                            context.fieldListLast Ź add;
                            };
                        };
                    ENDCASE => NULL;
                };
            IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 1]];
            IF pass <= 2 THEN DoList[identifierNode, Each];
            IF pass = 2 THEN Assert[AnalyzeTypePass[context, typeNode, 2]];
            IF pass = 3 THEN AnalyzeInitialValue[context, typeNode, initialValueNode];
            };
        RETURN[With3[tree, typedecl, D]];
        };

    FieldListFromEnumeration: PUBLIC PROC [items: LIST OF EnumerationItem, rangeType: TypeCode] RETURNS [FieldList] = {
        RETURN [
            IF items = NIL
            THEN NIL ELSE
            CONS[[name: items.first.name, rangeType: rangeType], FieldListFromEnumeration[items.rest, rangeType]]
            ]
        };

    AnalyzeFieldList: PUBLIC PROC [context: Context, fieldListNode: Tree] RETURNS [FieldList] = {
        fieldList: FieldList Ź NIL;
        last: FieldList Ź NIL;
        Append: PROC [f: FieldListItem] = {
            <<Ought to check for duplicates here.>>
            IF last = NIL
                THEN last Ź fieldList Ź LIST[f]
                ELSE {last.rest Ź LIST[f]; last Ź last.rest};
            };
        Each: PROC [fieldListEntryNode: Tree] = {
            FieldDecl: PROC [idsNode, typeNode, valueNode: Tree] = {
                EachId: PROC [fieldNameNode: Tree] = {
                    id: ROPE Ź NIL;
                    rangeType: TypeCode Ź nullTypeCode;
                    Item: PROC [idNode, constantNode: Tree] = {
                        <<This is for the machine-dependent case.>>
                        <<For now, we ignore constantNode, which may be a constant expression (the word offset) or an item whose first component is a word 
                        offset and whose second component is an item containing the first and last bit numbers.>>
                        id Ź IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
                        };
                    IF NOT With2[fieldNameNode, item, Item] AND fieldNameNode # NIL THEN id Ź GetIdentifier[fieldNameNode];
                    rangeType Ź GetTypeValueAttribute[context.types, typeNode];
                    IF valueNode # NIL THEN {
                        rangeType Ź NewInitialType[context.types, context.moduleName, valueNode, rangeType];
                        };
                    Append[[name: id, rangeType: rangeType]];
                    };
                AnalyzeType2[context, typeNode];
                AddTypeCodeAttribute[fieldListEntryNode, $DECLTYPECODE, GetTypeValueAttribute[context.types, typeNode]];
                IF idsNode = NIL
                    THEN Append[[name: NIL, rangeType: GetTypeValueAttribute[context.types, typeNode]]]
                    ELSE DoList[idsNode, EachId];
                };
            Assert[With3[fieldListEntryNode, decl, FieldDecl]];
            };
        DoList[fieldListNode, Each];
        RETURN [fieldList]
        };

    AnalyzeFieldListValues: PROC [context: Context, fieldListNode: Tree] = {
        Each: PROC [fieldListEntryNode: Tree] = {
            FieldDecl: PROC [idsNode, typeNode, valueNode: Tree] = {
                AnalyzeInitialValue[context, typeNode, valueNode];
                };
            Assert[With3[fieldListEntryNode, decl, FieldDecl]];
            };
        DoList[fieldListNode, Each];
        };

    AnalyzeVariantList: PUBLIC PROC [context: Context, variantListNode: Tree] RETURNS [VariantList] = {
        variantList: VariantList Ź NIL;
        last: VariantList Ź NIL;
        Append: PROC [f: VariantListItem] = {
            <<Ought to check for duplicates here.>>
            IF last = NIL
                THEN last Ź variantList Ź LIST[f]
                ELSE {last.rest Ź LIST[f]; last Ź last.rest};
            };
        Each: PROC [variantListEntryNode: Tree] = {
            VariantDecl: PROC [idsNode, typeNode, valueNode: Tree] = {
                fieldList: FieldList Ź NIL;
                VariantTC: PROC [fieldListNode: Tree] = {
                    fieldList Ź AnalyzeFieldList[context, fieldListNode];
                    };
                EachId: PROC [idNode: Tree] = {
                    tagId: ROPE = GetIdentifier[idNode];
                    Append[[value: tagId, chooses: fieldList]];
                    };
                Assert[With1[typeNode, variantTC, VariantTC]];
                Assert[valueNode=NIL, "initial value on variant part ignored",,variantListEntryNode];
                DoList[idsNode, EachId];
                };
            Assert[With3[variantListEntryNode, typedecl, VariantDecl]];
            };
        DoList[variantListNode, Each];
        RETURN [variantList]
        };

    AnalyzeVariantListValues: PUBLIC PROC [context: Context, variantListNode: Tree] = {
        Each: PROC [variantListEntryNode: Tree] = {
            VariantDecl: PROC [idsNode, typeNode, valueNode: Tree] = {
                VariantTC: PROC [fieldListNode: Tree] = {
                    AnalyzeFieldListValues[context, fieldListNode];
                    };
                Assert[With1[typeNode, variantTC, VariantTC]];
                Assert[valueNode=NIL, "Initial value on variant part ignored",,variantListEntryNode];
                };
            Assert[With3[variantListEntryNode, typedecl, VariantDecl]];
            };
        DoList[variantListNode, Each];
        };

    AnalyzeInitialValue: PROC [context: Context, typeNode, valueNode: REF] = {
        [] Ź AnalyzeTypePass[context, typeNode, 3];
        IF valueNode # NIL THEN {
            typeCode: TypeCode = GetTypeValueAttribute[context.types, typeNode];
            AddTypeCodeAttribute[valueNode, $NEEDTYPECODE, typeCode];
            WITH UnderType[context.types, typeCode] SELECT FROM
                c: REF TypeRep.control => NULL;
                ENDCASE => {
                    Assert[CrankAnalyze.AnalyzeExpression[context, valueNode],"Expr expected",,valueNode];
                    };
            };
        };

    GetLink: SIGNAL RETURNS [TypeCode] = CODE; -- for linkTC nested in listTC; sorry about this

    AnalyzeType: PUBLIC PROC [context: Context, tree: Tree] = {
        Assert[AnalyzeTypePass[context, tree, 1],"Need type",,tree];
        [] Ź AnalyzeTypePass[context, tree, 2];
        [] Ź AnalyzeTypePass[context, tree, 3];
        };

    AnalyzeType2: PROC [context: Context, tree: Tree] = {
        Assert[AnalyzeTypePass[context, tree, 1],"Need type",,tree];
        [] Ź AnalyzeTypePass[context, tree, 2];
        };

    AnalyzeTypePass: PUBLIC PROC [context: Context, tree: Tree, pass: [1..3]] RETURNS [BOOL] = {
        <<Pass 1 assigns the $TYPECODE attribute and creates an entry in the type graph.>>
        <<Pass 2 fills it in, assuming the other symbols in the context are at least partially defined>>
        <<Pass 3 analyzes the initial value of component types, and fills in qualifiers>>
        self: AttributedNode = NARROW[tree];
        IndicateTypeCode: PROC [typeCode: TypeCode] = {
            AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, typeCode]];
            };
        IndicateType: PROC [type: Type] = {
            IndicateTypeCode[NewType[context.types, type]];
            };
        ReferenceTypes: PROC RETURNS [BOOL] = {
            ReferenceTC: PROC [referentTypeNode: REF] = {
                SELECT pass FROM
                    1 => {
                        IndicateTypeCode[NewReferenceType[context.types, nullTypeCode, SELECT GetNodeName[self] FROM $REFTC => $REF, $POINTERTC => 
                        $POINTER, $LISTTC => $LIST, ENDCASE => NIL]];
                        };
                    2 => {
                        type: REF TypeRep.reference Ź NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                        AnalyzeType2[context, referentTypeNode
                            ! GetLink => {RESUME[type.typeCode]} -- for linkTC nested in listTC; sorry about this
                            ];
                        type.referentType Ź GetTypeValueAttribute[context.types, referentTypeNode];
                        <<The following confused Dot interpretation, so we don't do it.>>
                        <<IF GetNodeName[self] = $LISTTC THEN {>>
                            <<WITH TypeFromTypeCode[context.types, type.referentType] SELECT FROM>>
                                <<r: REF TypeRep.record => {>>
                                    <<-- Referents of LIST types are unpainted.  It is OK to reach down and smash this, because the recordTC node was generated by the 
                                    parser, and so nobody else can refer to it.>>
                                    <<r.class _ $STRUCTURE;>>
                                    <<};>>
                                <<ENDCASE => Assert[FALSE];>>
                            <<};>>
                        };
                    3 => { [] Ź AnalyzeTypePass[context, referentTypeNode, 3] };
                    ENDCASE;
                };
            RelativeTC: PROC [baseTypeNode, referentTypeNode: REF] = {
                SELECT pass FROM
                    1 => {
                        IndicateTypeCode[NewReferenceType[context.types, nullTypeCode, $RELATIVEPOINTER]];
                        };
                    2 => {
                        type: REF TypeRep.reference Ź NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                        AnalyzeType2[context, baseTypeNode];
                        <<Should check for a base pointer.>>
                        AnalyzeType2[context, referentTypeNode];
                        type.referentType Ź GetTypeValueAttribute[context.types, referentTypeNode];
                        };
                    3 => {
                        [] Ź AnalyzeTypePass[context, baseTypeNode, 3];
                        [] Ź AnalyzeTypePass[context, referentTypeNode, 3];
                        };
                    ENDCASE;
                };
            RETURN [With1[self, refTC, ReferenceTC] OR With1[self, pointerTC, ReferenceTC] OR With1[self, listTC, ReferenceTC] OR With2[self, 
            relativeTC, RelativeTC]];
            };
        LinkTC: PROC = {
            SELECT pass FROM
                1 => {
                    IndicateTypeCode[SIGNAL GetLink]; -- sorry about this
                    };
                ENDCASE;
            };
        ZoneTC: PROC = {
            IF pass = 1 THEN IndicateType[NEW[TypeRep.simple Ź [class: $ZONE, v: simple[]]]];
            };
        ArraydescTC: PROC [referentTypeNode: REF] = {
            IF pass = 1 THEN IndicateType[NEW[TypeRep.array Ź [class: $ARRAYDESCRIPTOR, v: array[domainType: nullTypeCode, rangeType: 
            nullTypeCode]]]];
            };
        LongTC: PROC [referentTypeNode: REF] = {
            Assert[AnalyzeTypePass[context, referentTypeNode, pass]];
            IF pass = 1 THEN {
                referentTypeCode: TypeCode = GetTypeValueAttribute[context.types, referentTypeNode];
                referentType: REF TypeRep = UnderType[context.types, referentTypeCode];
                type: REF TypeRep Ź NIL;
                WITH referentType SELECT FROM
                    t: REF TypeRep.array => {
                        IF GetNodeName[referentTypeNode] = $ARRAYDESCTC THEN {
                            type Ź t; type.class Ź $LONGARRAYDESCRIPTOR
                            };
                        };
                    t: REF TypeRep.reference => {
                        SELECT t.class FROM
                            $POINTER => IF GetNodeName[referentTypeNode] = $POINTERTC THEN { type Ź t; type.class Ź $LONGPOINTER };
                            $REF, $LIST => { type Ź referentType };
                            ENDCASE => NULL;
                        };
                    t: REF TypeRep.scalar => {
                        SELECT t.class FROM
                            $INT16 => {
                                type Ź UnderType[context.types, LookupTypeCode[Root[context], "INT32"]]
                                };
                            $CARD16 => {
                                type Ź UnderType[context.types, LookupTypeCode[Root[context], "CARD32"]]
                                };
                            ENDCASE => NULL;
                        };
                    ENDCASE => NULL;
                Assert[type # NIL, "LONG unimplemented in this context",,self];
                IF type = NIL THEN RETURN;
                IF type = referentType
                    THEN IndicateTypeCode[referentTypeCode]
                    ELSE IndicateType[type];
                };
            };
        ArrayTC: PROC [domainTypeNode, rangeTypeNode: REF] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.array = NEW[TypeRep.array Ź [class: $ARRAY, v: array[domainType: nullTypeCode, rangeType: nullTypeCode]]];
                    IndicateType[type];
                    };
                2 => {
                    type: REF TypeRep.array = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    AnalyzeType2[context, domainTypeNode];
                    AnalyzeType2[context, rangeTypeNode];
                    type.domainType Ź GetTypeValueAttribute[context.types, domainTypeNode];
                    type.rangeType Ź GetTypeValueAttribute[context.types, rangeTypeNode];
                    AddTypeCodeAttribute[rangeTypeNode, $DECLTYPECODE, type.rangeType];
                    };
                3 => {
                    [] Ź AnalyzeTypePass[context, domainTypeNode, 3];
                    [] Ź AnalyzeTypePass[context, rangeTypeNode, 3];
                    };
                ENDCASE;
            };
        SubrangeTC: PROC [groundTypeNode, intervalNode: REF] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.subrange = NEW[TypeRep.subrange];
                    type.class Ź $SUBRANGE;
                    IndicateType[type];
                    };
                2 => {
                    type: REF TypeRep.subrange = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    first: DINT Ź DINT.FIRST;
                    last: DINT Ź DINT.LAST;
                    groundTypeCode: TypeCode Ź nullTypeCode;
                    Interval: PROC [lowNode, highNode: REF] = {
                        AddTypeCodeAttribute[lowNode, $NEEDTYPECODE, groundTypeCode];
                        PropagateAttribute[highNode, $NEEDTYPECODE, NARROW[lowNode], $NEEDTYPECODE];
                        Assert[CrankAnalyze.AnalyzeExpression[context, lowNode],"low not an expr",,self];
                        Assert[CrankAnalyze.AnalyzeExpression[context, highNode],"high not an expr",,self];
                        first Ź GetSimpleConstant[context, lowNode ! Error => CONTINUE];
                        last Ź GetSimpleConstant[context, highNode ! Error => CONTINUE];
                        };
                    RefFromInt: PROC [int: DINT] RETURNS [REF] ~ {
                        SELECT int FROM
                            IN DINT[INT.FIRST..INT.LAST] => RETURN [NEW[INT Ź int]];
                            IN DINT[CARD.FIRST..CARD.LAST] => RETURN [NEW[CARD Ź int]];
                            ENDCASE => RETURN [NEW[DINT Ź int]];
                        };
                    AnalyzeType2[context, groundTypeNode];
                    groundTypeCode Ź GetTypeValueAttribute[context.types, groundTypeNode];
                    SELECT TRUE FROM
                        With2[intervalNode, intOO, Interval] => { first Ź first+1; last Ź last-1 };
                        With2[intervalNode, intCO, Interval] => { last Ź last-1 };
                        With2[intervalNode, intOC, Interval] => { first Ź first+1 };
                        With2[intervalNode, intCC, Interval] => NULL;
                        ENDCASE => Assert[FALSE];
                    type.groundType Ź groundTypeCode;
                    type.first Ź RefFromInt[first];
                    type.last Ź RefFromInt[last];
                    };
                3 => { [] Ź AnalyzeTypePass[context, groundTypeNode, 3] };
                ENDCASE;
            };
        DefinitionTC: PROC = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.record = NEW[TypeRep.record Ź [class: $DEFINITIONS, v: record[fieldList: NIL]]];
                    IndicateType[type];
                    };
                ENDCASE;
            };
        ControlTC: PROC [domainNode, rangeNode: REF] = {
            class: TypeClass Ź SELECT GetNodeName[self] FROM
                $PROCTC => $PROC,
                $SIGNALTC => $SIGNAL,
                $ERRORTC => $ERROR,
                $PROGRAMTC => $PROGRAM,
                $PROCESSTC => $PROCESS,
                ENDCASE => ERROR;
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.control = NEW[TypeRep.control Ź [class: class, v: control[argumentType: nullTypeCode, returnType: nullTypeCode]]];
                    IndicateType[type];
                    <<Will need to insert the symbols into the context of the body>>
                    };
                2 => {
                    type: REF TypeRep.control = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    TypeCodeOf: PROC [listNode: REF] RETURNS [TypeCode] = {
                        type: Type = IF listNode # NIL AND GetNodeName[listNode] = $ANYTC
                            THEN NEW[TypeRep.simple Ź [class: $ANY, v: simple[]]]
                            ELSE NEW[TypeRep.record Ź [class: $STRUCTURE, v: record[fieldList: AnalyzeFieldList[context, listNode]]]];
                        RETURN [NewType[context.types, type]]
                        };
                    type.argumentType Ź TypeCodeOf[domainNode];
                    type.returnType Ź TypeCodeOf[rangeNode];
                    };
                3 => {
                    type: REF TypeRep.control = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    WITH UnderType[context.types, type.argumentType] SELECT FROM
                        s: REF TypeRep.record => {AnalyzeFieldListValues[context, domainNode]};
                        ENDCASE => NULL;
                    WITH UnderType[context.types, type.returnType] SELECT FROM
                        s: REF TypeRep.record => {AnalyzeFieldListValues[context, rangeNode]};
                        ENDCASE => NULL;
                    };
                ENDCASE;
            };
        RecordTC: PROC [fieldListNode: REF] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.record = NEW[TypeRep.record Ź [class: $RECORD, v: record[fieldList: NIL]]];
                    IndicateType[type];
                    };
                2 => {
                    type: REF TypeRep.record = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    type.fieldList Ź AnalyzeFieldList[context, fieldListNode];
                    };
                3 => {
                    AnalyzeFieldListValues[context, fieldListNode]
                    };
                ENDCASE;
            };
        UnionTC: PROC [tagDeclNode, variantsNode: REF] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.union = NEW[TypeRep.union];
                    type.class Ź $UNION;
                    IndicateType[type];
                    };
                2 => {
                    type: REF TypeRep.union = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    TagDecl: PROC [tagIdNode, typeNode, valueNode: Tree] = {
                        ImplicitTC: PROC = {
                            <<Need to cons up an enumerated type for type.tagType.>>
                            <<type.variantList has been contructed already.>>
                            Count: PROC [v: VariantList] RETURNS [i: INT Ź 0] = INLINE {WHILE v # NIL DO i Ź i + 1; v Ź v.rest ENDLOOP};
                            n: INT = Count[type.variantList];
                            tagType: REF TypeRep.enumerated = NEW[TypeRep.enumerated Ź [class: $ENUMERATION, v: enumerated[items: NIL]]];
                            last: LIST OF EnumerationItem Ź NIL;
                            i: INT Ź 0;
                            FOR each: VariantList Ź type.variantList, each.rest UNTIL each = NIL DO
                                new: LIST OF EnumerationItem Ź LIST[[NARROW[each.first.value], i]];
                                IF last = NIL THEN tagType.items Ź new ELSE last.rest Ź new;
                                last Ź new;
                                i Ź i + 1;
                                ENDLOOP;
                            type.tagType Ź NewType[context.types, tagType];
                            };
                        Item: PROC [idNode, constantNode: Tree] = {
                            <<This is for the machine-dependent case.>>
                            <<For now, we ignore constantNode, which may be a constant expression (the word offset) or an item whose first component is a word 
                            offset and whose second component is an item containing the first and last bit numbers.>>
                            type.tagName Ź IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
                            };
                        IF tagIdNode # NIL AND NOT With2[tagIdNode, item, Item] THEN type.tagName Ź GetIdentifier[tagIdNode];
                        Assert[valueNode = NIL, "Initializer not allowed on tag decl",,tree];
                        IF NOT With0[typeNode, implicitTC, ImplicitTC] THEN {
                            AnalyzeType2[context, typeNode];
                            type.tagType Ź GetTypeValueAttribute[context.types, typeNode];
                            };
                        };
                    type.variantList Ź AnalyzeVariantList[context, variantsNode];
                    Assert[With3[tagDeclNode, decl, TagDecl]];
                    AddTypeCodeAttribute[tagDeclNode, $DECLTYPECODE, type.tagType];
                    <<Should check tags in type.variantList against type.tagType, and for duplicates.>>
                    };
                3 => {
                    AnalyzeVariantListValues[context, variantsNode];
                    };
                ENDCASE;
            };
        SequenceTC: PROC [limitDeclNode, rangeTypeNode: Tree] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.sequence = NEW[TypeRep.sequence];
                    type.class Ź $SEQUENCE;
                    IndicateType[type];
                    };
                2 => {
                    type: REF TypeRep.sequence = NARROW[TypeFromTypeCode[context.types, GetTypeValueAttribute[context.types, self]]];
                    LimitDecl: PROC [idNode, typeNode, valueNode: Tree] = {
                        id: ROPE = IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
                        AnalyzeType2[context, typeNode];
                        type.limitName Ź id;
                        type.domainType Ź GetTypeValueAttribute[context.types, typeNode];
                        type.rangeType Ź GetTypeValueAttribute[context.types, rangeTypeNode];
                        Assert[valueNode=NIL, "initial value on sequence limit ignored",, self];
                        };
                    AnalyzeType2[context, rangeTypeNode];
                    Assert[With3[limitDeclNode, decl, LimitDecl]];
                    AddTypeCodeAttribute[limitDeclNode, $DECLTYPECODE, type.rangeType];
                    };
                3 => { [] Ź AnalyzeTypePass[context, rangeTypeNode, 3] };
                ENDCASE;
            };
        EnumeratedTC: PROC [idsNode: Tree] = {
            SELECT pass FROM
                1 => {
                    val: CARD Ź 0;
                    type: REF TypeRep.enumerated = NEW[TypeRep.enumerated];
                    last: LIST OF EnumerationItem Ź NIL;
                    Each: PROC [enumItem: Tree] = {
                        id: ROPE Ź NIL;
                        new: LIST OF EnumerationItem Ź NIL;
                        Item: PROC [idNode, constantNode: Tree] = {
                            <<This is for the machine-dependent case>>
                            newVal: CARD = GetSimpleConstant[context, constantNode];
                            id Ź IF idNode # NIL THEN GetIdentifier[idNode] ELSE NIL;
                            Assert[newVal >= val, "Enumeration out of order: %g", [cardinal[newVal]], idsNode];
                            val Ź newVal;
                            };
                        IF NOT With2[enumItem, item, Item] THEN id Ź GetIdentifier[enumItem];
                        new Ź LIST[[id, val]];
                        IF last = NIL THEN type.items Ź new ELSE last.rest Ź new;
                        last Ź new;
                        val Ź val + 1;
                        };
                    type.class Ź $ENUMERATION;
                    val Ź 0; DoList[idsNode, Each]; -- first pass determines range
                    IndicateType[type];
                    };
                2 => {
                    <<All work has been done in the first pass.>>
                    };
                ENDCASE;
            };
        VarTC: PROC [baseTypeNode: Tree] = { -- used for READONLY, VAR
            [] Ź AnalyzeTypePass[context, baseTypeNode, pass];
            IF GetAttribute[self, $TYPECODE] = NIL THEN {
                PropagateAttribute[self, $TYPECODE, NARROW[baseTypeNode], $TYPECODE];
                };
            };
        AnyTC: PROC = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.simple = NEW[TypeRep.simple];
                    type.class Ź $ANY;
                    IndicateType[type];
                    };
                ENDCASE;
            };
        OpaqueTC: PROC [REF] = {
            SELECT pass FROM
                1 => {
                    type: REF TypeRep.simple = NEW[TypeRep.simple];
                    type.class Ź $OPAQUE;
                    IndicateType[type];
                    };
                ENDCASE;
            };
        TypeExpression: PROC RETURNS [BOOL] = {
            SELECT pass FROM
                1 => {
                    IF self # NIL THEN {
                        AddTypeCodeAttribute[self, $NEEDTYPECODE, 0]; -- 0 is predeclared to mean the right thing.
                        RETURN [CrankAnalyze.AnalyzeExpression[context, self]];
                        };
                    RETURN [FALSE]
                    };
                2, 3 => {
                    IF pass = 3 THEN TypeExprPass3[context, self];
                    WITH UnderType[context.types, GetTypeCodeAttribute[self]] SELECT FROM
                        t: REF TypeRep.type => RETURN [TRUE];
                        ENDCASE => RETURN [FALSE];
                    };
                ENDCASE => ERROR;
            };
        RETURN[With1[self, enumeratedTC, EnumeratedTC] OR With1[self, recordTC, RecordTC] OR With1[self, monitoredTC, RecordTC] OR 
        ReferenceTypes[] OR With2[self, arrayTC, ArrayTC] OR With2[self, sequenceTC, SequenceTC] OR With2[self, procTC, ControlTC] 
        OR With2[self, signalTC, ControlTC] OR With2[self, errorTC, ControlTC] OR With2[self, programTC, ControlTC] OR With2[self, 
        processTC, ControlTC] OR With1[self, varTC, VarTC] OR With0[self, anyTC, AnyTC] OR With2[self, unionTC, UnionTC] OR 
        With2[self, subrangeTC, SubrangeTC] OR With0[self, zoneTC, ZoneTC] OR With1[self, arraydescTC, ArraydescTC] OR With1[self, 
        longTC, LongTC] OR With1[self, opaqueTC, OpaqueTC] OR With0[self, linkTC, LinkTC] OR With0[self, definitionTC, 
        DefinitionTC] OR TypeExpression[]];
        };

    TypeExprPass3: PROC [context: Context, tree: Tree] = {
        self: AttributedNode = NARROW[tree];
        Apply: PROC [operatorNode, operandListNode, catchNode: REF] = {
            SELECT self.syntaxNodeName FROM
                $DISCRIMINATE => TypeExprPass3[context, operatorNode];
                $SEQUENCEALLOC => TypeExprPass3[context, operatorNode];
                ENDCASE => Assert[FALSE,"What was this?",,self];
            };
        Dot: PROC [leftNode, rightNode: REF] = {
            SELECT self.syntaxNodeName FROM
                $DISCRIMINATE => TypeExprPass3[context, leftNode];
                $INTERFACESELECT => NULL;
                ENDCASE => Assert[FALSE,"What was this?",,self];
            };
        Identifier: PROC [id: ROPE] = {
            IF GetAttribute[self, $QUAL] = NIL THEN {
                WITH LookupSymbol[context, id] SELECT FROM
                    ste: REF SymbolTableEntryRep.other => { QualifyIdentifierNode[self, ste.qualifier] };
                    ENDCASE => Assert[FALSE,"What was this?",,self];
                };
            };
        Assert[WithId[self, Identifier] OR With3[self, apply, Apply] OR With2[self, dot, Dot],"What was this?",,self];
        };

    FindExportee: PROC [context: Context, name: ROPE] RETURNS [to: ROPE Ź NIL, tc: TypeCode Ź nullTypeCode] = {
        matches: INT Ź 0;
        FOR e: LIST OF Export Ź context.exports, e.rest UNTIL e = NIL DO
            FOR f: FieldList Ź e.first.fieldList, f.rest UNTIL f = NIL DO
                IF Rope.Equal[f.first.name, name] THEN {
                    to Ź e.first.interfaceName;
                    tc Ź f.first.rangeType;
                    matches Ź matches + 1;
                    EXIT;
                    };
                ENDLOOP;
            ENDLOOP;
        IF matches # 1 THEN {
            [] Ź Help[IO.PutFR["%g is exported to %g interfaces", [rope[name]], [integer[matches]]]];
            };
        };

    TryExportingType: PROC [context: Context, name: ROPE, concrete: TypeCode] RETURNS [to: ROPE Ź NIL] = {
        matches: INT Ź 0;
        FOR each: LIST OF Export Ź context.exports, each.rest UNTIL each = NIL DO
            FOR f: FieldList Ź each.first.fieldList, f.rest UNTIL f = NIL DO
                IF Rope.Equal[f.first.name, name] THEN {
                    WITH UnderType[context.types, f.first.rangeType] SELECT FROM
                        t: REF TypeRep.type => {
                            opaque: REF TypeRep = UnderType[context.types, t.value];
                            IF opaque.class = $OPAQUE THEN {
                                ExportType[context: context, concrete: concrete, opaque: opaque.typeCode];
                                to Ź each.first.interfaceName;
                                matches Ź matches + 1;
                                EXIT;
                                };
                            };
                        ENDCASE => NULL;
                    };
                ENDLOOP;
            ENDLOOP;
        IF matches # 1 THEN {
            [] Ź Help[IO.PutFR["%g is exported to %g interfaces", [rope[name]], [integer[matches]]]];
            };
        };

    ProcessModuleList: PUBLIC PROC [context: Context, moduleList: Tree, import: BOOL] = {
        Action: PROC [item: Tree] = {
            E: PROC [rename, name: REF] = {
                id: ROPE = GetIdentifier[name];
                reid: ROPE = GetIdentifier[rename];
                ste: REF SymbolTableEntryRep.directory Ź NARROW[LookupSymbol[context, id]];
                IF NOT Rope.Equal[reid, id] THEN {
                    new: REF SymbolTableEntryRep.directory Ź NEW[SymbolTableEntryRep.directory Ź ste­];
                    AddSymbol[context, reid, new];
                    ste Ź new;
                    };
                Assert[NOT (IF import THEN ste.import ELSE ste.export)]; -- check for duplicates
                IF import THEN ste.import Ź TRUE ELSE ste.export Ź TRUE;
                IF NOT import THEN {
                    context.exports Ź CONS[[id, ste.interfaceRecordType.fieldList], context.exports];
                    };
                };
            Assert[With2[item, item, E]];
            };
        DoList[moduleList, Action];
        };

    ProcessSharesList: PUBLIC PROC [context: Context, moduleList: Tree] = {
        Action: PROC [item: Tree] = {
            id: ROPE = GetIdentifier[item];
            ste: REF SymbolTableEntryRep.directory Ź NARROW[LookupSymbol[context, id]];
            Assert[NOT ste.share];
            ste.share Ź TRUE;
            };
        DoList[moduleList, Action];
        };

    AddDirectoryItem: PUBLIC PROC [context: Context, tree: Tree] = {
        D: PROC [directoryItem, from, usingList: REF] = {
            ste: REF SymbolTableEntryRep.directory Ź NEW[SymbolTableEntryRep.directory];
            directoryItemName: ROPE = GetIdentifier[directoryItem];
            ste.import Ź FALSE;
            ste.export Ź FALSE;
            ste.from Ź IF from = NIL THEN directoryItemName ELSE GetRopeLiteral[from];
            ste.interfaceRecordType Ź CrankAnalyze.GetSymbols[context, ste.from];
            IF usingList = NIL
                THEN { ste.hasUsing Ź FALSE; ste.using Ź NIL }
                ELSE {
                    list: LIST OF ROPE Ź NIL;
                    Action: PROC [item: Tree] = { list Ź CONS[GetIdentifier[item], list] };
                    DoList[usingList, Action];
                    ste.hasUsing Ź TRUE;
                    ste.using Ź list;
                    };
            AddSymbol[context, directoryItemName, ste];
            };
        Assert[With3[tree, diritem, D]];
        };

    END.