<<>>
    <<CrankOneImpl.mesa>>
        <<Copyright Ó 1987, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, March 22, 1993 5:22 pm PST>>
        <<>>
    DIRECTORY List, ProcessProps, IO, VersionMap, VersionMapDefaults, CrankIO, CrankTypes, FS, MPTree, MPLeaves, Rope, CrankOps, 
    CrankAnalyze, SymTab, CedarProcess;

    CrankOneImpl: CEDAR MONITOR
    IMPORTS List, ProcessProps, IO, VersionMap, VersionMapDefaults, CrankIO, FS, Rope, CrankOps, CrankAnalyze, SymTab, CedarProcess
    EXPORTS CrankAnalyze
    ~ BEGIN OPEN CrankTypes, CrankOps, CrankAnalyze;

        ROPE: TYPE = Rope.ROPE;
<<Driver>>
    runOn: BOOL Ź TRUE; -- If TRUE, errors with non-empty messages will get caught and logged.
    saveContext: BOOL Ź TRUE; -- hack to avoid re-doing a lot of interfaces.
    globalContext: Context Ź NIL; -- monitored

    warnPointerArith: BOOL Ź FALSE;
    mimosa: BOOL = TRUE;

    AllocContext: ENTRY PROC RETURNS [context: Context] = {
        ENABLE UNWIND => NULL;
        IF saveContext AND globalContext # NIL
            THEN { context Ź globalContext; globalContext Ź NIL }
            ELSE {
                context Ź NewContext[NIL];
                DeclareBuiltIns[context];
                };
        context Ź NewContext[context]; -- don't pass out the context with the builtins without shadowing it.
        };

    FreeContext: ENTRY PROC [context: Context] = {
        IF saveContext THEN globalContext Ź Root[context];
        };

    SrcLoc: PROC [tree: Tree] RETURNS [loc: INT Ź INT.LAST] = {
        WITH tree SELECT FROM
            aNode: AttributedNode => {
                WITH aNode.syntaxNode SELECT FROM
                    node: REF MPTree.Node => {
                        FOR i: NAT IN [1..node.sonLimit) DO
                            loc Ź SrcLoc[node.son[i]];
                            IF loc # INT.LAST THEN RETURN;
                            ENDLOOP;
                        };
                    ht: REF MPLeaves.HTNode => RETURN [ht.index];
                    lt: REF MPLeaves.LTIndex => RETURN [lt.index];
                    ENDCASE => NULL;
                };
            ENDCASE => NULL;
        };

    PushSource: SIGNAL [newSource: ROPE] = CODE;

    PopSource: SIGNAL = CODE;

    Convert: PUBLIC PROC [fileName: ROPE, analyze: BOOL, action: PROC [tree: Tree, context: Context]] ~ {
        Inner: PROC = {
            fullFName: ROPE = GetFullName[fileName];
            attachedName: ROPE = FS.FileInfo[fullFName].attachedTo;
            sourceName: ROPE = IF attachedName # NIL THEN attachedName ELSE FS.FileInfo[fullFName].fullFName;
            sources: LIST OF ROPE Ź LIST[sourceName];
            logName: ROPE = CrankIO.MakeOutputName[fullFName, "crankErrors"];
            log: IO.STREAM = FS.StreamOpen[fileName: logName, accessOptions: create];
            tree: Tree Ź CrankIO.AddAttributeNodes[CrankIO.ParseFile[fullFName]];
            errorCount: INT Ź 0;
            IF analyze
                THEN {
                    context: Context = AllocContext[];
                    AnalyzeModule[context, tree ! 
                        CrankOps.Error => IF runOn AND Rope.Size[message] > 0 THEN {
                            loc: INT Ź SrcLoc[tree];
                            errorCount Ź errorCount + 1;
                            WITH ProcessProps.GetProp[$StdOut] SELECT FROM
                                errout: IO.STREAM => {
                                    IO.PutRope[errout, "  Error: "];
                                    IO.PutRope[errout, message];
                                    IF loc # INT.LAST THEN IO.PutF[errout, "  \"%g|%g\"", [rope[sources.first]], [integer[loc]]];
                                    IO.PutRope[errout, "\n"];
                                    };
                                ENDCASE => NULL;
                            IO.PutRope[log, "  Error: "];
                            IO.PutRope[log, message];
                            IF loc # INT.LAST THEN IO.PutF[log, "  \"%g|%g\"", [rope[sources.first]], [integer[loc]]];
                            IF tree # NIL THEN IO.PutF1[log, " %g", [refAny[CrankIO.RopeFromTree[tree]]]];
                            IO.PutRope[log, "\n"];
                            IO.Flush[log];
                            RESUME;
                            };
                        PushSource => {sources Ź CONS[newSource, sources]; RESUME};
                        PopSource => {sources Ź sources.rest; RESUME};
                        ];
                    ComputeExternalTypeRep[context.types];
                    FillTypeAttributes[context.types, tree];
                    action[tree, context];
                    FreeContext[context];
                    }
                ELSE { action[tree, NIL] };
            IF errorCount # 0
                THEN {
                    IO.PutF[log, "\n %g error%g reported.\n", [integer[errorCount]], [rope[IF errorCount = 1 THEN "" ELSE "s"]]];
                    IO.Close[log];
                    }
                ELSE {
                    fullLogName: ROPE = FS.GetName[FS.OpenFileFromStream[log]].fullFName;
                    IO.Close[self: log, abort: TRUE];
                    FS.Delete[name: fullLogName ! FS.Error => CONTINUE];
                    };
            };
        CedarProcess.DoWithPriority[priority: background, action: Inner]
        };

    ConvertFile: PUBLIC PROC [fileName: ROPE, structure: BOOL, analyze: BOOL, skipAttributes: LIST OF ATOM] RETURNS [resultFileName: 
    ROPE Ź NIL] = {
        fullFName: ROPE = GetFullName[fileName];
        attachedName: ROPE = FS.FileInfo[fullFName].attachedTo;
        outputName: ROPE = CrankIO.MakeOutputName[fullFName, "sexpr"];
        sourceName: ROPE = IF attachedName # NIL THEN attachedName ELSE FS.FileInfo[fullFName].fullFName;
        Inner: PROC [tree: Tree, context: Context] = {
            resultFileName Ź (IF structure THEN CrankIO.WriteSTree[tree, outputName, united, sourceName, skipAttributes] ELSE 
            CrankIO.WriteTree[tree, outputName, sourceName, skipAttributes]);
            };
        Convert[fileName: fullFName, analyze: analyze, action: Inner];
        };
<<Support>>
    GetUnderQualifier: PROC [context: Context, qual: ROPE, id: ROPE, typeCode: TypeCode] RETURNS [ROPE] = {
        <<If a type, finds the right qualifier for the original definition.>>
        WITH UnderType[context.types, typeCode] SELECT FROM
            ty: REF TypeRep.type => {
                IF ty.value # nullTypeCode THEN {
                    tc: TypeCode Ź ty.value;
                    DO
                        WITH TypeFromTypeCode[context.types, tc] SELECT FROM
                            d: REF TypeRep.definition => {
                                IF Rope.Equal[d.shortName, id] THEN qual Ź d.qualifier;
                                tc Ź d.groundType;
                                };
                            i: REF TypeRep.initial => {
                                tc Ź i.groundType;
                                };
                            ENDCASE => EXIT;
                        ENDLOOP;
                    };
                };
            ENDCASE => NULL;
        RETURN [qual];
        };

    HasInitialValuesForAllArgs: PROC [typeGraph: TypeGraph, c: REF TypeRep.control] RETURNS [BOOL] ~ {
        WITH UnderType[typeGraph, c.argumentType] SELECT FROM
            s: REF TypeRep.record => {
                FOR f: FieldList Ź s.fieldList, f.rest UNTIL f = NIL DO
                    IF TypeFromTypeCode[typeGraph, f.first.rangeType].class # $INITIAL THEN RETURN [FALSE]
                    ENDLOOP;
                };
            ENDCASE => NULL;
        RETURN [TRUE]
        };

    TypeCodePair: TYPE = RECORD [aCode, bCode: TypeCode];

    maxTypeImplNest: NAT Ź 20;
    Implies: PROC [context: Context, aCode, bCode: TypeCode] RETURNS [BOOL] = {
        typeGraph: TypeGraph ~ context.types;
        nestLimit: NAT Ź maxTypeImplNest;
        inductiveEquivalents: LIST OF TypeCodePair Ź NIL;
        InductivelyEquivalent: PROC [ac, bc: TypeCode] RETURNS [BOOL] = {
            FOR each: LIST OF TypeCodePair Ź inductiveEquivalents, each.rest UNTIL each = NIL DO
                IF ac = each.first.aCode AND bc = each.first.bCode THEN RETURN [TRUE]
                ENDLOOP;
            RETURN [FALSE];
            };
        Imp: PROC [aCode, bCode: TypeCode] RETURNS [ans: BOOL Ź FALSE] = {
            nestLimit Ź nestLimit - 1;
            Assert[nestLimit > 0, "Type recursion too deep"];
            IF nestLimit > 0 THEN ans Ź Imp1[aCode, bCode];
            nestLimit Ź nestLimit + 1;
            };
        Imp1: PROC [aCode, bCode: TypeCode] RETURNS [BOOL] = {
            a: Type = UnderType[typeGraph, aCode];
            b: Type = UnderType[typeGraph, bCode];
            nestLimit Ź nestLimit - 1;
            IF a = b OR (b#NIL AND b.class = $ANY) OR (a#NIL AND a.class = $UNSPECIFIED) OR (b#NIL AND b.class = $UNSPECIFIED) OR (a#NIL AND 
            b#NIL AND InductivelyEquivalent[a.typeCode, b.typeCode]) THEN RETURN [TRUE];
            IF a = NIL OR b = NIL THEN RETURN [FALSE];
            IF b.class = $OPAQUE THEN {
                concrete: TypeCode = GetConcreteTypeCode[context, b.typeCode];
                IF concrete # nullTypeCode THEN RETURN [Imp[a.typeCode, concrete]]
                };
            WITH a SELECT FROM
                a: REF TypeRep.scalar => {
                    WITH b SELECT FROM
                        b: REF TypeRep.subrange => {
                            RETURN [Imp[a.typeCode, b.groundType]] -- This is more generous than it should be; may need a range check.
                            };
                        ENDCASE => NULL;
                    RETURN [a.class = b.class];
                    };
                a: REF TypeRep.subrange => { RETURN [Imp[a.groundType, b.typeCode]] };
                a: REF TypeRep.reference => {
                    WITH b SELECT FROM
                        b: REF TypeRep.reference => {
                            save: LIST OF TypeCodePair Ź inductiveEquivalents;
                            imp: BOOL Ź FALSE;
                            IF a.class = b.class THEN {
                                inductiveEquivalents Ź CONS[[a.typeCode, b.typeCode], inductiveEquivalents];
                                };
                            IF a.class = $LIST AND b.class = $LIST
                                THEN {
                                    <<Since the record pointed to by a LIST is not painted, we base the result on the type implication of the "first" field.>>
                                    WITH UnderType[typeGraph, a.referentType] SELECT FROM
                                        ar: REF TypeRep.record => {
                                            WITH b SELECT FROM
                                                b: REF TypeRep.reference => {
                                                    WITH UnderType[typeGraph, b.referentType] SELECT FROM
                                                        br: REF TypeRep.record => {
                                                            imp Ź Imp[ar.fieldList.first.rangeType, br.fieldList.first.rangeType];
                                                            };
                                                        ENDCASE => NULL;
                                                    };
                                                ENDCASE => NULL;
                                            };
                                        ENDCASE => NULL;
                                    }
                                ELSE {
                                    imp Ź (a.class = b.class OR (a.class = $POINTER AND b.class = $LONGPOINTER) OR (a.class = $LIST AND b.class = $REF)) AND 
                                    Imp[a.referentType, b.referentType];
                                    };
                            inductiveEquivalents Ź save;
                            RETURN [imp]
                            };
                        ENDCASE => RETURN [FALSE];
                    };
                a: REF TypeRep.record => {
                    IF a.class = $STRUCTURE AND b.class = $STRUCTURE THEN {
                        WITH b SELECT FROM
                            b: REF TypeRep.record => {
                                af: FieldList Ź a.fieldList;
                                bf: FieldList Ź b.fieldList;
                                WHILE af # NIL AND bf # NIL DO
                                    IF Imp[af.first.rangeType, bf.first.rangeType] 
                                        THEN { af Ź af.rest; bf Ź bf.rest }
                                        ELSE EXIT;
                                    ENDLOOP;
                                IF af = NIL AND bf = NIL THEN RETURN [TRUE];
                                };
                            ENDCASE => NULL;
                        };
                    IF a.fieldList # NIL AND a.fieldList.rest = NIL THEN {
                        RETURN [Imp[a.fieldList.first.rangeType, b.typeCode]]
                        };
                    };
                a: REF TypeRep.qualifiedVariant => {
                    WITH b SELECT FROM
                        b: REF TypeRep.qualifiedVariant => {
                            IF (Rope.Equal[a.qualifier, b.qualifier] AND Imp[a.groundType, b.groundType]) THEN RETURN [TRUE];
                            };
                        ENDCASE => NULL;
                    IF Imp[a.groundType, b.typeCode] THEN RETURN [TRUE];
                    };
                a: REF TypeRep.array => {
                    WITH b SELECT FROM
                        b: REF TypeRep.array => {
                            RETURN [Imp[a.rangeType, b.rangeType]] -- This is sloppy; should check the sizes, too.
                            };
                        ENDCASE => NULL;
                    };
                a: REF TypeRep.enumerated => {
                    WITH b SELECT FROM
                        b: REF TypeRep.subrange => {
                            RETURN [Imp[a.typeCode, b.groundType]] -- This is more generous than it should be; may need a range check.
                            };
                        ENDCASE => NULL;
                    RETURN [FALSE]; -- assume always painted
                    };
                a: REF TypeRep.control => {
                    WITH b SELECT FROM
                        b: REF TypeRep.control => {
                            save: LIST OF TypeCodePair Ź inductiveEquivalents;
                            imp: BOOL Ź FALSE;
                            inductiveEquivalents Ź CONS[[a.typeCode, b.typeCode], inductiveEquivalents];
                            imp Ź a.class = b.class AND Imp[b.argumentType, a.argumentType] AND Imp[a.returnType, b.returnType];
                            inductiveEquivalents Ź save;
                            RETURN [imp];
                            };
                        ENDCASE => NULL;
                    };
                a: REF TypeRep.simple => {
                    IF a.class = $OPAQUE THEN {
                        concrete: TypeCode = GetConcreteTypeCode[context, a.typeCode];
                        RETURN [IF concrete # nullTypeCode THEN Imp[concrete, b.typeCode] ELSE FALSE];
                        };
                    RETURN [a.class = b.class];
                    };
                a: REF TypeRep.type => RETURN [a.class = b.class];
                ENDCASE => NULL;
            RETURN [FALSE];
            };
        RETURN [Imp[aCode, bCode]];
        };

    Coercions: PROC [context: Context, from: TypeCode, to: TypeCode, tree: Tree] RETURNS [LIST OF REF] = {
        <<The tree is used only for indicating errors.>>
        <<$DEREFERENCE, $FLOAT, $SELECTSINGLETON, $PROCAPPLY, $WIDEN, $BOUNDSCHECK, $LOOPHOLE, $ERRORVALUE>>
        typeGraph: TypeGraph ~ context.types;
        coercions: LIST OF REF Ź NIL;
        toType: Type Ź UnderType[typeGraph, to];
        tc: TypeCode Ź from;
        DO
            WITH toType SELECT FROM
                t: REF TypeRep.record => {
                    IF t.fieldList # NIL AND t.fieldList.rest = NIL THEN {
                        toType Ź UnderType[typeGraph, t.fieldList.first.rangeType];
                        LOOP;
                        };
                    };
                ENDCASE => NULL;
            EXIT;
            ENDLOOP;
        IF toType.class = $UNSPECIFIED THEN RETURN [CONS[$LOOPHOLE, coercions]];
        WHILE tc # nullTypeCode DO
            type: Type = UnderType[typeGraph, tc];
            IF type = NIL THEN EXIT;
            IF type.class = $UNSPECIFIED THEN RETURN [CONS[$LOOPHOLE, coercions]];
            IF Implies[context, type.typeCode, toType.typeCode] THEN RETURN [coercions];
            WITH type SELECT FROM
                t: REF TypeRep.scalar => {
                    IF toType.class = $REAL THEN {
                        SELECT t.class FROM
                            $INT16, $INT32, $DINT, $CARD16, $CARD32, $DCARD => RETURN [CONS[$FLOAT, coercions]];
                            $REAL, $DREAL => RETURN [coercions];
                            ENDCASE => NULL;
                        };
                    WITH toType SELECT FROM
                        s: REF TypeRep.subrange => {
                            coercions Ź CONS[$BOUNDSCHECK, coercions];
                            toType Ź UnderType[typeGraph, s.groundType];
                            LOOP;
                            };
                        s: REF TypeRep.scalar => {
                            SELECT t.class FROM
                                $INT16, $INT32, $DINT, $CARD16, $CARD32, $DCARD => {
                                    SELECT s.class FROM
                                        $INT16, $INT32, $DINT, $CARD16, $CARD32, $DCARD => {
                                            RETURN [CONS[$BOUNDSCHECK, coercions]];
                                            };
                                        ENDCASE => NULL;
                                    };
                                ENDCASE => NULL;
                            };
                        s: REF TypeRep.enumerated => {
                            IF t.class = $ATOM THEN {
                                RETURN [CONS[$ENUMERATIONLITERALFROMATOM, coercions]];
                                };
                            };
                        ENDCASE => NULL;
                    };
                t: REF TypeRep.record => {
                    IF t.fieldList # NIL AND t.fieldList.rest = NIL THEN {
                        tc Ź t.fieldList.first.rangeType;
                        LOOP;
                        };
                    };
                t: REF TypeRep.qualifiedVariant => {
                    coercions Ź CONS[$WIDEN, coercions];
                    tc Ź t.groundType;
                    LOOP;
                    };
                t: REF TypeRep.reference => {
                    coercions Ź CONS[$DEREFERENCE, coercions];
                    tc Ź t.referentType;
                    LOOP;
                    };
                t: REF TypeRep.control => {
                    IF t.class = $PROC THEN {
                        IF HasInitialValuesForAllArgs[typeGraph, t] THEN {
                            coercions Ź CONS[$PROCAPPLY, coercions];
                            tc Ź t.returnType;
                            LOOP
                            };
                        };
                    IF t.class = $ERROR THEN {
                        coercions Ź CONS[$ERRORVALUE, coercions];
                        RETURN [coercions];
                        };
                    };
                t: REF TypeRep.subrange => {
                    coercions Ź CONS[$WIDEN, coercions];
                    tc Ź t.groundType;
                    LOOP;
                    };
                t: REF TypeRep.enumerated => {
                    WITH toType SELECT FROM
                        s: REF TypeRep.subrange => {
                            coercions Ź CONS[$BOUNDSCHECK, coercions];
                            toType Ź UnderType[typeGraph, s.groundType];
                            LOOP;
                            };
                        ENDCASE => NULL;
                    };
                ENDCASE => NULL;
            EXIT;
            ENDLOOP;
        RETURN [NARROW[Help["Could not do this coercion",,tree]]];
        };

    BuiltinType: PROC [context: Context, id: ROPE, type: Type] = {
        dtype: Type = IF type.infoClass = record OR type.infoClass = enumerated THEN NEW[TypeRep.definition Ź [class: $DEFINITION, v: 
        definition[qualifier: NIL, shortName: id, groundType: NewType[context.types, type]]]] ELSE type;
        typeCode: TypeCode = NewType[context.types, dtype];
        typeTypeCode: TypeCode = NewTypeType[context.types, typeCode];
        AddSymbol[context, id, NEW[SymbolTableEntryRep.other Ź [other[typeCode: typeTypeCode, readonly: TRUE]]]];
        };

    GetSequenceInfo: PROC [typeGraph: TypeGraph, typeCode: TypeCode] RETURNS [domain: Type Ź NIL, sequenceFieldName: ROPE Ź NIL, 
    sequenceTypeCode: TypeCode Ź nullTypeCode] = {
        Action: PROC [fieldIndex: INT, fieldName: ROPE, fieldTypeCode: TypeCode, tagName: ROPE, tagTypeCode: TypeCode] RETURNS [quit: BOOL 
        Ź FALSE] = {
            IF tagTypeCode # nullTypeCode AND UnderType[typeGraph, fieldTypeCode].class = $SEQUENCE THEN {
                domain Ź TypeFromTypeCode[typeGraph, tagTypeCode];
                sequenceFieldName Ź fieldName;
                sequenceTypeCode Ź fieldTypeCode;
                RETURN [TRUE]
                }
            };
        WITH UnderType[typeGraph, typeCode] SELECT FROM
            r: REF TypeRep.record => {
                [] Ź EnumerateFields[typeGraph, typeCode, Action];
                };
            q: REF TypeRep.qualifiedVariant => {
                [] Ź EnumerateFields[typeGraph, typeCode, Action];
                };
            ENDCASE => NULL;
        };

    GetListElementTypeCode: PROC [typeGraph: TypeGraph, listTypeCode: TypeCode] RETURNS [TypeCode] = {
        listType: Type = UnderType[typeGraph, listTypeCode];
        WITH listType SELECT FROM
            lt: REF TypeRep.reference => {
                WITH UnderType[typeGraph, lt.referentType] SELECT FROM
                    rt: REF TypeRep.record => {
                        IF rt.fieldList # NIL THEN RETURN [rt.fieldList.first.rangeType]
                        };
                    ENDCASE => NULL;
                };
            ENDCASE => NULL;
        RETURN [nullTypeCode]
        };

    <<princopbuiltins: ROPE = ">>
        <<BUILTIN: CEDAR DEFINITIONS = {>>
            <<BOOL: TYPE = {FALSE, TRUE};>>
            <<FALSE: BOOL = FALSE;>>
            <<TRUE: BOOL = TRUE;>>
            <<BOOLEAN: TYPE = BOOL;>>
            <<NAT: TYPE = INT16[0..32767];>>
            <<BYTE: TYPE = INT16[0..255];>>
            <<CHARACTER: TYPE = CHAR;>>
            <<INTEGER: TYPE = INT16;>>
            <<INT: TYPE = INT32;>>
            <<CARD: TYPE = CARD32;>>
            <<CARDINAL: TYPE = CARD16;>>
            <<WORD: TYPE = CARD16;>>
            <<UNIT: TYPE = CARD16;>>
            <<AtomRep: PRIVATE TYPE;>>
            <<ATOM: TYPE = REF AtomRep;>>
            <<MONITORLOCK, LOCK: TYPE;>>
            <<CONDITION: TYPE;>>
            <<TEXT: TYPE = MACHINE DEPENDENT RECORD [length: NAT15, text: PACKED SEQUENCE maxLength: NAT15 OF CHAR];>>
            <<-- VAL: PROC [CARDINAL] RETURNS [UNSPECIFIED] = MACHINE CODE {};>>
            <<-- ORD: PROC [UNSPECIFIED] RETURNS [CARDINAL] = MACHINE CODE {};>>
            <<REAL32: TYPE ~ REAL;>>
            <<NAT15: TYPE ~ INT16[0..32767];>>
            <<StringBody: TYPE = MACHINE DEPENDENT RECORD [length: NAT15, text: PACKED SEQUENCE maxlength: NAT15 OF CHAR];>>
            <<STRING: TYPE ~ POINTER TO StringBody;>>
            <<}.>>
        <<";>>
        <<>>
    builtins: ROPE = "
        BUILTIN: CEDAR DEFINITIONS = {
            BOOL: TYPE = {FALSE, TRUE};
            FALSE: BOOL = FALSE;
            TRUE: BOOL = TRUE;
            BOOLEAN: TYPE = BOOL;
            NAT15: TYPE ~ INT16[0..32767];
            NAT31: TYPE ~ INT32[0..INT32.LAST];
            NAT: TYPE = NAT31;
            BYTE: TYPE = INT16[0..255];
            CHARACTER: TYPE = CHAR;
            INTEGER: TYPE = INT32;
            INT: TYPE = INT32;
            CARD: TYPE = CARD32;
            CARDINAL: TYPE = CARD32;
            WORD: TYPE = CARD32;
            UNIT: TYPE = BYTE;
            AtomRep: PRIVATE TYPE;
            ATOM: TYPE = REF AtomRep;
            MONITORLOCK, LOCK: TYPE;
            CONDITION: TYPE;
            TEXT: TYPE = MACHINE DEPENDENT RECORD [length: NAT15, text: PACKED SEQUENCE maxLength: NAT15 OF CHAR];
            REAL32: TYPE ~ REAL;
            StringBody: TYPE = MACHINE DEPENDENT RECORD [length: NAT15, text: PACKED SEQUENCE maxlength: NAT15 OF CHAR];
            STRING: TYPE ~ POINTER TO StringBody;
            }.
        ";

    DeclareBuiltIns: PROC [context: Context] = {
        builtinTree: Tree = CrankIO.AddAttributeNodes[CrankIO.ParseRope[builtins]];
        word64: REF TypeRep.scalar= NEW[TypeRep.scalar Ź [class: $DCARD, v: scalar[]]];
        word32: REF TypeRep.scalar= NEW[TypeRep.scalar Ź [class: $CARD32, v: scalar[]]];
        word16: REF TypeRep.scalar= NEW[TypeRep.scalar Ź [class: $CARD16, v: scalar[]]];
        BuiltinType[context, "INT16", NEW[TypeRep.scalar Ź [class: $INT16, v: scalar[]]]];
        BuiltinType[context, "REAL", NEW[TypeRep.scalar Ź [class: $REAL, v: scalar[]]]];
        BuiltinType[context, "DREAL", NEW[TypeRep.scalar Ź [class: $DREAL, v: scalar[]]]];
        BuiltinType[context, "DINT", NEW[TypeRep.scalar Ź [class: $DINT, v: scalar[]]]];
        BuiltinType[context, "DCARD", word64];
        BuiltinType[context, "DWORD", word64];
        BuiltinType[context, "INT32", NEW[TypeRep.scalar Ź [class: $INT32, v: scalar[]]]];
        BuiltinType[context, "CHAR", NEW[TypeRep.scalar Ź [class: $CHAR, v: scalar[]]]];
        BuiltinType[context, "CARD32", word32];
        BuiltinType[context, "WORD32", word32];
        BuiltinType[context, "CARD16", word16];
        BuiltinType[context, "WORD16", word16];
        BuiltinType[context, "UNSPECIFIED", NEW[TypeRep.scalar Ź [class: $UNSPECIFIED, v: scalar[]]]];
        AnalyzeModule[context, builtinTree];
        WITH TypeFromTypeCode[context.types, GetTypeCodeAttribute[builtinTree]] SELECT FROM
            r: REF TypeRep.record => IF r.class = $DEFINITIONS THEN {
                FOR each: FieldList Ź r.fieldList, each.rest UNTIL each = NIL DO
                    AddSymbol[context, each.first.name, NEW[SymbolTableEntryRep.other Ź [other[typeCode: each.first.rangeType, readonly: TRUE, 
                    constantValue: NIL]]]];
                    ENDLOOP;
                };
            ENDCASE => ERROR;
        Assert[SymTab.Delete[context.symbols, "AtomRep"]];
        Assert[SymTab.Delete[context.symbols, "BUILTIN"]];
        context.moduleName Ź NIL;
        };

    NumericTypeClass: TYPE = { signed, unsigned, real, pointer, char, unspecified, reference, enumeration, nonnumeric };
        <<reference allows only eq tests>>
        <<enumeration allows only comparisons>>
        <<nonnumeric allows only composite equality tests>>

    NumericTypeClassOf: PROC [typeGraph: TypeGraph, typeCode: TypeCode] RETURNS [NumericTypeClass] = {
        WITH UnderType[typeGraph, typeCode] SELECT FROM
            s: REF TypeRep.subrange => { RETURN [NumericTypeClassOf[typeGraph, s.groundType]] };
            s: REF TypeRep.record => {
                IF s.fieldList # NIL AND s.fieldList.rest = NIL THEN RETURN [NumericTypeClassOf[typeGraph, s.fieldList.first.rangeType]];
                };
            s: REF TypeRep.scalar => {
                SELECT s.class FROM
                    $INT16, $INT32, $DINT => RETURN [signed];
                    $CARD16, $CARD32, $DCARD => RETURN [unsigned];
                    $UNSPECIFIED => RETURN [unspecified];
                    $CHAR => RETURN [char];
                    $REAL, $DREAL => RETURN [real];
                    ENDCASE => NULL;
                };
            s: REF TypeRep.reference => {
                SELECT s.class FROM
                    $POINTER, $LONGPOINTER => RETURN [pointer];
                    $REF, $LIST => RETURN [reference];
                    ENDCASE => NULL;
                };
            s: REF TypeRep.control => { RETURN [reference] };
            s: REF TypeRep.enumerated => { RETURN [enumeration] };
            ENDCASE => NULL;
        RETURN [nonnumeric];
        };

    NamesFromFieldList: PROC [fieldList: FieldList] RETURNS [LIST OF REF] = {
        IF fieldList = NIL OR fieldList.first.name = NIL THEN RETURN [NIL];
        RETURN [CONS[fieldList.first.name, NamesFromFieldList[fieldList.rest]]]
        };

    GetTags: PROC [typeGraph: TypeGraph, typeCode: TypeCode] RETURNS [LIST OF REF] = {
        tc: TypeCode Ź typeCode;
        tags: LIST OF REF Ź NIL;
        DO
            WITH UnderType[typeGraph, tc] SELECT FROM
                q: REF TypeRep.qualifiedVariant => {
                    tc Ź q.groundType;
                    tags Ź List.Nconc1[tags, q.qualifier];
                    };
                ENDCASE => EXIT;
            ENDLOOP;
        RETURN [tags];
        };
<<Symbols from Interfaces>>
    NameFromVersionMap: PROC [shortName: ROPE] RETURNS [fullFName: ROPE] = {
        rangeList: VersionMap.RangeList Ź VersionMap.ShortNameToRanges[VersionMapDefaults.GetMapList[$Source], shortName];
        FOR each: VersionMap.RangeList Ź rangeList, each.rest UNTIL each = NIL DO
            SELECT each.first.len FROM
                0 => NULL;
                1 => RETURN [VersionMap.RangeToEntry[each.first].name]
                ENDCASE => RETURN [NARROW[Help["\"%g\" is ambiguous", [rope[shortName]]]]];
            ENDLOOP;
        RETURN [NIL];
        };

    GetFullName: PROC [fileName: ROPE] RETURNS [ROPE] = {
        <<This supplies a .mesa extension if needed.  If no directory is provided, it looks first in the local directory and then in the 
        version map.>>
        fullFName: ROPE;
        cp: FS.ComponentPositions;
        found: BOOL Ź TRUE;
        [fullFName, cp] Ź FS.ExpandName[fileName];
        IF cp.ext.length = 0 THEN {
            [fullFName, cp] Ź FS.ExpandName[Rope.Replace[base: fullFName, start: cp.base.start+cp.base.length, len: 
            cp.ver.start-(cp.base.start+cp.base.length), with: ".mesa"]];
            };
        fullFName Ź FS.FileInfo[name: fullFName ! FS.Error => IF error.group=user THEN {found Ź FALSE; CONTINUE}].fullFName;
        IF NOT found AND Rope.Fetch[fileName, 0] >= 'A THEN {
            fullFName Ź NameFromVersionMap[Rope.Substr[fullFName, cp.base.start, cp.base.length+cp.ext.length+1]];
            };
        RETURN [fullFName]
        };

    GetSymbols: PUBLIC PROC [context: Context, interfaceFileName: ROPE] RETURNS [REF TypeRep.record] = {
        fullFName: ROPE = GetFullName[interfaceFileName];
        WITH SymTab.Fetch[context.types.interfaceTable, fullFName].val SELECT FROM
            r: REF TypeRep.record => RETURN [r];
            a: ATOM => Assert[a # $INPROGRESS, "Recursive interface structure"];
            ENDCASE => {
                IF fullFName # NIL THEN {
                    tree: Tree = CrankIO.AddAttributeNodes[CrankIO.ParseFile[fullFName]];
                    innerContext: Context = NewContext[context];
                    Assert[SymTab.Insert[context.types.interfaceTable, fullFName, $INPROGRESS]];
                    WITH ProcessProps.GetProp[$StdOut] SELECT FROM
                        errout: IO.STREAM => IO.PutF[errout, "[%g from %g\n", [rope[interfaceFileName]], [rope[fullFName]]];
                        ENDCASE => NULL;
                    SIGNAL PushSource[fullFName];
                    AnalyzeModule[innerContext, tree];
                    SIGNAL PopSource;
                    WITH ProcessProps.GetProp[$StdOut] SELECT FROM
                        errout: IO.STREAM => IO.PutF1[errout, "End %g ]\n", [rope[interfaceFileName]]];
                        ENDCASE => NULL;
                    WITH TypeFromTypeCode[context.types, GetTypeCodeAttribute[tree]] SELECT FROM
                        r: REF TypeRep.record => IF r.class = $DEFINITIONS THEN {
                            [] Ź SymTab.Store[context.types.interfaceTable, fullFName, r];
                            RETURN [r];
                            };
                        ENDCASE => NULL;
                    [] Ź Help["\"%g\" is not a DEFINITIONS file", [rope[fullFName]],tree];
                    };
                };
        RETURN [NIL]
        };
<<Semantic analysis>>
    GetLeftRelOperand: SIGNAL RETURNS [Tree] = CODE;

    AnalyzeBlockOrBody: PROC [context: Context, tree: Tree] = {
        AnalyzeBodyOrExpression[context, tree, NIL, 1];
        AnalyzeBodyOrExpression[context, tree, NIL, 2];
        AnalyzeBodyOrExpression[context, tree, NIL, 3];
        };

    AnalyzeBodyOrExpression: PUBLIC PROC [context: Context, tree: Tree, parent: AttributedNode, pass: [1..3]] = {
        self: AttributedNode = NARROW[tree];
        Block: PROC [declarationsNode, bodyContentsNode: REF] = {
            Body[openNode: NIL, declarationsNode: declarationsNode, bodyContentsNode: bodyContentsNode, exitsNode: NIL];
            };
        Open: PROC [itemNode, bodyContentsNode: REF] = {
            Body[openNode: itemNode, declarationsNode: NIL, bodyContentsNode: bodyContentsNode, exitsNode: NIL];
            };
        Body: PROC [openNode, declarationsNode, bodyContentsNode, exitsNode: REF] = {
            innerContext: Context Ź NIL;
            EachDecl: PROC [item: Tree] = {
                Assert[AnalyzeDecl[innerContext, item, self, pass] OR AnalyzeTypeDecl[innerContext, item, self, pass]];
                };
            EachStatement: PROC [item: Tree] = {
                AnalyzeStatement[innerContext, item];
                };
            IF pass = 1
                THEN {
                    innerContext Ź NewContext[context];
                    IF openNode # NIL THEN {
                        OpenItem: PROC [itemNode: REF] = {
                            Item: PROC [renameNode, exprNode: REF] = {
                                tc: TypeCode Ź nullTypeCode;
                                dereferenceCount: INT Ź 0;
                                AddFields: PROC = {
                                    openId: ROPE = GenSym[context.types, "OPEN$"];
                                    AddAttribute[NARROW[openNode], $OPENID, openId];
                                    IF dereferenceCount > 0 THEN {
                                        AddAttribute[NARROW[openNode], $DEREFERENCE, NEW[INT Ź dereferenceCount]];
                                        };
                                    IF renameNode # NIL
                                        THEN {
                                            renameID: ROPE = GetIdentifier[renameNode];
                                            AddSymbol[innerContext, renameID, NEW[SymbolTableEntryRep.other Ź [other[typeCode: tc, readonly: TRUE, constantValue: NIL, 
                                            qualifier: openId]]]];
                                            }
                                        ELSE {
                                            Action: PROC [fieldIndex: INT, fieldName: ROPE, fieldTypeCode: TypeCode, tagName: ROPE, tagTypeCode: TypeCode] RETURNS [quit: BOOL 
                                            Ź FALSE] = {
                                                IF fieldName # NIL THEN {
                                                    AddSymbol[innerContext, fieldName, NEW[SymbolTableEntryRep.other Ź [other[typeCode: fieldTypeCode, readonly: FALSE, constantValue: 
                                                    NIL, qualifier: openId]]]];
                                                    };
                                                IF tagName # NIL THEN {
                                                    AddSymbol[innerContext, tagName, NEW[SymbolTableEntryRep.other Ź [other[typeCode: tagTypeCode, readonly: TRUE, constantValue: NIL, 
                                                    qualifier: openId]]]];
                                                    };
                                                };
                                            [] Ź EnumerateFields[context.types, tc, Action];
                                            };
                                    };
                                Assert[AnalyzeExpression[context, exprNode]];
                                tc Ź GetTypeCodeAttribute[exprNode];
                                DO
                                    WITH UnderType[context.types, tc] SELECT FROM
                                        t: REF TypeRep.record => {
                                            SELECT t.class FROM
                                                $STRUCTURE => {
                                                    IF t.fieldList # NIL AND t.fieldList.rest = NIL AND t.fieldList.first.name = NIL THEN {
                                                        tc Ź t.fieldList.first.rangeType;
                                                        LOOP;
                                                        };
                                                    AddFields[];
                                                    };
                                                $DEFINITIONS => {
                                                    IF renameNode # NIL
                                                        THEN AddFields[]
                                                        ELSE {
                                                            id: ROPE = GetIdentifier[exprNode];
                                                            WITH LookupSymbol[context, id] SELECT FROM
                                                                ste: REF SymbolTableEntryRep.directory => {
                                                                    fieldList: FieldList = ste.interfaceRecordType.fieldList;
                                                                    FOR each: FieldList Ź fieldList, each.rest UNTIL each = NIL DO
                                                                        name: ROPE = each.first.name;
                                                                        use: BOOL Ź NOT ste.hasUsing;
                                                                        FOR u: LIST OF ROPE Ź ste.using, u.rest UNTIL use OR u=NIL DO
                                                                            use Ź Rope.Equal[name, u.first];
                                                                            ENDLOOP;
                                                                        IF use THEN {
                                                                            AddSymbol[innerContext, each.first.name, NEW[SymbolTableEntryRep.other Ź [other[typeCode: each.first.rangeType, readonly: FALSE, 
                                                                            constantValue: NIL, qualifier: 
                                                                            GetUnderQualifier[context, id, each.first.name, 
                                                                            each.first.rangeType]]]]];
                                                                            };
                                                                        ENDLOOP;
                                                                    };
                                                                ENDCASE => [] Ź Help["%g is not a DIRECTORY item", [rope[id]], openNode];
                                                            };
                                                    };
                                                $RECORD => {AddFields[]};
                                                ENDCASE => NULL;
                                            };
                                        t: REF TypeRep.qualifiedVariant => {AddFields[]};
                                        t: REF TypeRep.simple => {
                                            IF t.class = $OPAQUE
                                                THEN {
                                                    concrete: TypeCode = GetConcreteTypeCode[context, t.typeCode];
                                                    IF concrete # nullTypeCode THEN {tc Ź concrete; LOOP};
                                                    }
                                                ELSE EXIT;
                                            };
                                        t: REF TypeRep.reference => {
                                            tc Ź t.referentType; -- try some dereferencing
                                            dereferenceCount Ź dereferenceCount + 1;
                                            LOOP;
                                            };
                                        ENDCASE => NULL;
                                    EXIT;
                                    ENDLOOP;
                                innerContext Ź NewContext[innerContext];
                                };
                            Assert[With2[itemNode, item, Item]];
                            };
                        DoList[openNode, OpenItem];
                        };
                    AddAttribute[self, $CONTEXT, innerContext];
                    WITH UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]] SELECT FROM
                        type: REF TypeRep.control => {
                            arguments: REF TypeRep.record = NARROW[TypeFromTypeCode[context.types, type.argumentType]];
                            returns: REF TypeRep.record = NARROW[TypeFromTypeCode[context.types, type.returnType]];
                            AddSymbol[innerContext, "*RETURN-VALUE*", NEW[SymbolTableEntryRep.other Ź [other[typeCode: type.returnType, readonly: FALSE, 
                            constantValue: NIL]]]];
                            AddFieldListToContext[innerContext, arguments.fieldList];
                                <<-- makes the names of the arguments known within the body.>>
                            AddFieldListToContext[innerContext, returns.fieldList];
                                <<-- makes the names of the return values known within the body.>>
                            IF type.class = $PROGRAM THEN { innerContext.scopeKind Ź globalImpl };
                            };
                        type: REF TypeRep.record => {
                            Assert[type.class = $DEFINITIONS];
                            innerContext.fieldListLast Ź type.fieldList Ź LIST[[NIL, nullTypeCode]];
                                <<This creates a list head to accumulate the defined fields of the interface.  This list head gets removed by AnalyzeDecl>>
                            innerContext.scopeKind Ź globalDefs;
                            };
                        ENDCASE => NULL;
                    }
                ELSE { innerContext Ź NARROW[GetAttribute[self, $CONTEXT]] };
            DoList[declarationsNode, EachDecl];
            IF pass = 3 THEN DoList[bodyContentsNode, EachStatement];
            Assert[exitsNode = NIL, "EXITS not implemented",, tree];
            };
        Inline: PROC [listNode: REF] = {
            <<This is MACHINE CODE; it takes a list of lists, but we will just ignore it.>>
            };
        EntryOrInternal: PROC [bodyNode: REF] = {
            IF pass = 1 THEN PropagateAttribute[bodyNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            AnalyzeBodyOrExpression[context, bodyNode, NIL, pass];
            };
        Assert[With2[tree, block, Block] OR With4[tree, body, Body] OR With1[tree, entry, EntryOrInternal] OR With1[tree, internal, 
        EntryOrInternal] OR With1[tree, inline, Inline] OR With2[tree, open, Open] OR (pass < 3 OR AnalyzeExpression[context, 
        tree])];
        };

    AnalyzeExpression: PUBLIC PROC [context: Context, tree: Tree] RETURNS [BOOL] = {
        RETURN [AnalyzeExpressionOrStatement[context, tree, FALSE]];
        };

    AnalyzeStatement: PUBLIC PROC [context: Context, tree: Tree] = {
        Assert[AnalyzeExpressionOrStatement[context, tree, TRUE], "Statement expected here",,tree];
        };

    AnalyzeInterval: PROC [context: Context, tree: Tree, needType: TypeCode] = {
        self: AttributedNode = NARROW[tree];
        Interval: PROC [lowBoundNode, highBoundNode: REF] = {
            AddTypeCodeAttribute[lowBoundNode, $NEEDTYPECODE, needType];
            Assert[AnalyzeExpression[context, lowBoundNode],"Need expr",,lowBoundNode];
            AddTypeCodeAttribute[highBoundNode, $NEEDTYPECODE, needType];
            Assert[AnalyzeExpression[context, highBoundNode],"Need expr",,highBoundNode];
            };
        IF NOT (With2[self, intOO, Interval] OR With2[self, intCO, Interval] OR With2[self, intOC, Interval] OR With2[self, intCC, 
        Interval]) THEN {
            <<Must be a enumeration or subrange type>>
            AnalyzeType[context, self];
            WITH UnderType[context.types, GetTypeValueAttribute[context.types, self]] SELECT FROM
                t: REF TypeRep.enumerated => {
                    };
                t: REF TypeRep.subrange => {
                    };
                ENDCASE => Assert[FALSE, "Interval, enumeration or subrange required here",, self];
            };
        };

    FieldSelect: PROC [context: Context, self: AttributedNode, leftTypeCode: TypeCode, t: Type, id: ROPE, dereferenceCount: NAT] 
    RETURNS [BOOL] = {
        Action: PROC [fieldIndex: INT, fieldName: ROPE, fieldTypeCode: TypeCode, tagName: ROPE, tagTypeCode: TypeCode] RETURNS [quit: BOOL 
        Ź FALSE] = {
            NoteAttributes: PROC [tc: TypeCode] = {
                AddAttribute[self, $SLOTNUMBER, NEW[INT Ź fieldIndex]];
                IF dereferenceCount > 0 THEN {
                    AddAttribute[self, $DEREFERENCE, NEW[INT Ź dereferenceCount]];
                    };
                AddTypeCodeAttribute[self, $TYPECODE, tc];
                };
            IF Rope.Equal[fieldName, id] THEN {
                <<N.B.: If there are nested variants, and the tags have the same name, this will select the first tag, but the compiler selects the 
                last.>>
                SELECT t.class FROM
                    $RECORD => {
                        self.syntaxNodeName Ź $RECORDFIELDSELECT;
                        AddAttribute[self, $FROM, GetTypeName[context, leftTypeCode, FALSE]];
                        };
                    $STRUCTURE => {
                        self.syntaxNodeName Ź $RETURNVALUESELECT;
                        };
                    $DEFINITIONS => {
                        self.syntaxNodeName Ź $INTERFACESELECT;
                        };
                    $QUALIFIEDVARIANT => {
                        self.syntaxNodeName Ź $VARIANTRECORDFIELDSELECT;
                        AddAttribute[self, $FROM, GetTypeName[context, leftTypeCode, FALSE]];
                        };
                    ENDCASE => [] Ź Help["Unknown type class: %g", [atom[t.class]], self];
                NoteAttributes[fieldTypeCode];
                RETURN [TRUE];
                };
            IF Rope.Equal[tagName, id] AND tagTypeCode # nullTypeCode THEN {
                AddAttribute[self, $FROM, GetTypeName[context, leftTypeCode, FALSE]];
                NoteAttributes[tagTypeCode];
                WITH UnderType[context.types, fieldTypeCode] SELECT FROM
                    u: REF TypeRep.union => {
                        self.syntaxNodeName Ź $TAGFIELDSELECT;
                        };
                    s: REF TypeRep.sequence => {
                        self.syntaxNodeName Ź $SEQUENCELIMITFIELDSELECT;
                        };
                    ENDCASE => Assert[FALSE];
                RETURN [TRUE];
                };
            };
        RETURN [EnumerateFields[context.types, leftTypeCode, Action]];
        };

    GetConstructorFieldList: PUBLIC PROC [context: Context, neededTypeCode: TypeCode] RETURNS [FieldList] = {
        IF neededTypeCode # nullTypeCode THEN {
            type: Type = UnderType[context.types, neededTypeCode];
            WITH type SELECT FROM
                t: REF TypeRep.record => { RETURN [t.fieldList] };
                t: REF TypeRep.array => {
                    WITH UnderType[context.types, t.domainType] SELECT FROM
                        d: REF TypeRep.enumerated => {
                            RETURN [FieldListFromEnumeration[d.items, t.rangeType]]
                            };
                        ENDCASE => {
                            f: FieldList = LIST[[name: NIL, rangeType: t.rangeType]];
                                <<Here we create one node that points to itself.  This should be OK, because>>
                                    <<A. it is not enough circular garbage to matter,>>
                                    <<B. we don't try to print it out,>>
                                    <<C. the place it is used below does not try to traverse it.>>
                                <<We do it this way because we don't have enough static constant evaluation to know how to do any better.>>
                            f.rest Ź f;
                            RETURN [f]
                            };
                    };
                ENDCASE => NULL;
            };
        Assert[FALSE, "Constructor of unknown type"];
        RETURN [NIL]
        };

    AnalyzeExpressionOrStatement: PROC [context: Context, tree: Tree, analyzeStatement: BOOL] RETURNS [BOOL] = {
        self: AttributedNode = NARROW[tree];
        FunnyApply: PROC [applyNode: REF] = {
            PropagateAttribute[applyNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            IF GetNodeName[applyNode] = $APPLY
                THEN { Assert[AnalyzeExpression[context, applyNode]] }
                ELSE { Apply[applyNode, NIL, NIL] };
            };
        Apply: PROC [operatorNode, operandListNode, catchNode: REF] = {
            typeCode: TypeCode Ź GetTypeCodeAttribute[self, $NEEDTYPECODE];
            fieldList: FieldList Ź NIL;
            keywordOperands: BOOL Ź FALSE;
            positionalOperands: BOOL Ź FALSE;
            AnalyzeOperand: PROC [exprNode: REF, rangeType: TypeCode] = {
                AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, rangeType];
                Assert[AnalyzeExpression[context, exprNode]]
                };
            EachOperand: PROC [operandListItemNode: REF] = {
                NamedOperand: PROC [nameNode, exprNode: REF] = {
                    id: ROPE = GetIdentifier[nameNode];
                    keywordOperands Ź TRUE;
                    Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
                    FOR each: FieldList Ź fieldList, each.rest UNTIL each = NIL DO
                        IF Rope.Equal[each.first.name, id, TRUE] THEN {
                            AnalyzeOperand[exprNode, each.first.rangeType];
                            RETURN;
                            };
                        ENDLOOP;
                    Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
                    };
                IF NOT With2[operandListItemNode, item, NamedOperand] THEN {
                    positionalOperands Ź TRUE;
                    Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
                    IF fieldList = NIL
                        THEN { [] Ź Help["Too many items in group",,self] }
                        ELSE {
                            AnalyzeOperand[operandListItemNode, fieldList.first.rangeType];
                            fieldList Ź fieldList.rest;
                            };
                    };
                };
            WITH UnderType[context.types, typeCode] SELECT FROM
                u: REF TypeRep.union => {
                    id: ROPE = GetIdentifier[operatorNode];
                    found: BOOL Ź FALSE;
                    FOR each: VariantList Ź u.variantList, each.rest UNTIL found OR each = NIL DO
                        IF Rope.Equal[id, NARROW[each.first.value]] THEN {
                            fieldList Ź each.first.chooses;
                            found Ź TRUE;
                            self.syntaxNodeName Ź $MAKEVARIANT;
                            };
                        ENDLOOP;
                    Assert[found, "%g does not name a variant", [rope[id]], self];
                    };
                ENDCASE => {
                    IF operatorNode = NIL
                        THEN {
                            <<A constructor of some sort.>>
                            tc: TypeCode Ź typeCode;
                            DO
                                WITH UnderType[context.types, tc] SELECT FROM
                                    t: REF TypeRep.array => {
                                        self.syntaxNodeName Ź $MAKEARRAY;
                                        AddAttribute[self, $DOMAINTYPE, GetTypeName[context, t.domainType, TRUE]];
                                        EXIT
                                        };
                                    t: REF TypeRep.record => {
                                        SELECT t.class FROM
                                            $RECORD => {
                                                self.syntaxNodeName Ź $MAKERECORD;
                                                AddAttribute[self, $FROM, GetTypeName[context, typeCode, TRUE]];
                                                };
                                            ENDCASE => [] Ź Help["I don't think this should happen",,tree];
                                        EXIT;
                                        };
                                    t: REF TypeRep.qualifiedVariant => tc Ź t.groundType;
                                    ENDCASE => {[] Ź Help["vasis?",,tree]; EXIT};
                                ENDLOOP;
                            fieldList Ź GetConstructorFieldList[context, tc];
                            }
                        ELSE {
                            tc: TypeCode Ź nullTypeCode;
                            dereferenceCount: NAT Ź 0;
                            Assert[AnalyzeExpression[context, operatorNode]];
                            tc Ź GetTypeCodeAttribute[operatorNode, $TYPECODE];
                            DO
                                WITH UnderType[context.types, tc] SELECT FROM
                                    t: REF TypeRep.control => {
                                        AssertNotVar[self];
                                        fieldList Ź GetConstructorFieldList[context, t.argumentType];
                                        self.syntaxNodeName Ź (
                                            SELECT t.class FROM
                                                $PROC => $FUNCTIONAPPLY,
                                                $SIGNAL => $SIGNALAPPLY,
                                                $ERROR => $ERRORAPPLY,
                                                $PROGRAM => $STARTAPPLY,
                                                ENDCASE => ERROR);
                                        IF t.class # $ERROR THEN typeCode Ź t.returnType;
                                        };
                                    t: REF TypeRep.array => {
                                        fieldList Ź LIST[[name: NIL, rangeType: t.domainType]];
                                        self.syntaxNodeName Ź $ARRAYACCESS;
                                        typeCode Ź t.rangeType;
                                        };
                                    t: REF TypeRep.type => {
                                        <<This might be a coercion, or an obsolete notation for variant records, or a concrete sequence type in a NEW or SIZE.>>
                                        need: Type = UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
                                        IF need#NIL AND need.class = $TYPE
                                            THEN {
                                                <<Looking for a type, so it can't be a coercion>>
                                                IF GetAttribute[self, $SIZEORNEW] # NIL THEN {
                                                    <<This is inside a SIZE or NEW, so it is OK to dive in deeper to see if we have a SEQUENCE type.>>
                                                    d: Type = GetSequenceInfo[context.types, t.value].domain;
                                                    IF d # NIL THEN {
                                                        AddTypeCodeAttribute[operandListNode, $NEEDTYPECODE, d.typeCode];
                                                        Assert[AnalyzeExpression[context, operandListNode], "expr required",,self];
                                                        AddTypeCodeAttribute[self, $TYPECODE, tc];
                                                        self.syntaxNodeName Ź $SEQUENCEALLOC;
                                                        RETURN
                                                        };
                                                    };
                                                {
                                                    <<This must be an obsolete notation for variant records>>
                                                    id: ROPE = GetIdentifier[operandListNode];
                                                    q: TypeCode = QualifyVariant[context.types, t.value, id];
                                                    AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, q]];
                                                    self.syntaxNodeName Ź $DISCRIMINATE;
                                                    RETURN; -- don't process the operand further!
                                                    };
                                                }
                                            ELSE {
                                                <<Looking for a non-type, so it must be a coercion or a named constructor>>
                                                WITH UnderType[context.types, t.value] SELECT FROM
                                                    r: REF TypeRep.record => {
                                                        self.syntaxNodeName Ź $MAKERECORD;
                                                        AddAttribute[self, $FROM, GetTypeName[context, t.value, TRUE]];
                                                        fieldList Ź r.fieldList;
                                                        };
                                                    a: REF TypeRep.array => {
                                                        self.syntaxNodeName Ź $MAKEARRAY;
                                                        AddAttribute[self, $DOMAINTYPE, GetTypeName[context, a.domainType, TRUE]];
                                                        };
                                                    ENDCASE => {
                                                        self.syntaxNodeName Ź $COERCE;
                                                        fieldList Ź LIST[[name: NIL, rangeType: t.value]]
                                                        };
                                                typeCode Ź t.value;
                                                };
                                        };
                                    t: REF TypeRep.qualifiedVariant => {
                                        <<This is probably a sugared sequence access.>>
                                        r: ROPE; s: TypeCode;
                                        [sequenceFieldName: r, sequenceTypeCode: s] Ź GetSequenceInfo[context.types, t.typeCode];
                                        IF s # nullTypeCode THEN {
                                            AddAttribute[self, $SEQUENCEFIELDNAME, r];
                                            AddAttribute[self, $TAGS, GetTags[context.types, t.typeCode]];
                                            tc Ź s;
                                            LOOP;
                                            };
                                        Assert[FALSE, "Unknown operator type for apply",,self];
                                        };
                                    t: REF TypeRep.record => {
                                        <<This is probably a sugared sequence access.>>
                                        r: ROPE; s: TypeCode;
                                        [sequenceFieldName: r, sequenceTypeCode: s] Ź GetSequenceInfo[context.types, t.typeCode];
                                        IF s # nullTypeCode THEN {
                                            AddAttribute[self, $SEQUENCEFIELDNAME, r];
                                            AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[operatorNode, $TYPECODE], FALSE]];
                                            tc Ź s;
                                            LOOP;
                                            };
                                        Assert[FALSE, "Unknown operator type for apply",,self];
                                        };
                                    t: REF TypeRep.sequence => {
                                        fieldList Ź LIST[[name: NIL, rangeType: t.domainType]];
                                        self.syntaxNodeName Ź $SEQUENCEACCESS;
                                        typeCode Ź t.rangeType;
                                        };
                                    t: REF TypeRep.reference => {
                                        <<Dereference until we can apply>>
                                        tc Ź t.referentType;
                                        dereferenceCount Ź dereferenceCount + 1;
                                        LOOP;
                                        };
                                    ENDCASE => Assert[FALSE, "Unknown operator type for apply",,self];
                                EXIT;
                                ENDLOOP;
                            IF dereferenceCount > 0 THEN {
                                AddAttribute[self, $DEREFERENCE, NEW[INT Ź dereferenceCount]];
                                };
                            };
                    };
            { fieldNames: LIST OF REF = NamesFromFieldList[fieldList];
                IF fieldNames # NIL THEN {
                    AddAttribute[self, $FIELDNAMES, fieldNames];
                    };
                };
            DoList[operandListNode, EachOperand];
            IF catchNode # NIL THEN Assert[With2[catchNode, catch, Catch]];
            AddTypeCodeAttribute[self, $TYPECODE, typeCode];
            };
        Error: PROC [operandNode: REF] = {
            Assert[AnalyzeExpression[context, operandNode]];
            };
        SysError: PROC = { };
        ListCons: PROC [zoneNode, listNode: REF ] = {
            elementTypeCode: TypeCode = GetListElementTypeCode[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
            EachElement: PROC [elementNode: REF] = {
                AddTypeCodeAttribute[elementNode, $NEEDTYPECODE, elementTypeCode];
                Assert[AnalyzeExpression[context, elementNode], "Expr needed here",, self];
                };
            DoList[listNode, EachElement];
            };
        If: PROC [conditionalNode, truePartNode, falsePartNode: REF] = {
            tc: TypeCode Ź IF analyzeStatement THEN nullTypeCode ELSE GetTypeCodeAttribute[self, $NEEDTYPECODE];
            AddTypeCodeAttribute[conditionalNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "BOOL"]];
            IF tc # nullTypeCode THEN PropagateAttribute[truePartNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            Assert[AnalyzeExpression[context, conditionalNode]];
            Assert[AnalyzeExpressionOrStatement[context, truePartNode, analyzeStatement]];
            IF NOT analyzeStatement THEN {
                IF tc = nullTypeCode THEN tc Ź GetTypeCodeAttribute[truePartNode];
                AddTypeCodeAttribute[falsePartNode, $NEEDTYPECODE, tc];
                };
            Assert[AnalyzeExpressionOrStatement[context, falsePartNode, analyzeStatement]];
            IF tc # nullTypeCode THEN AddTypeCodeAttribute[self, $TYPECODE, tc];
            };
        Do: PROC [iterationControlNode, terminationTestNode, whatsitNode, loopBodyNode, huhNode, whyNode: REF] = {
            innerContext: Context = NewContext[context];
            EachStatement: PROC [item: Tree] = {
                AnalyzeStatement[innerContext, item];
                };
            ForSeq: PROC [declNode, initValueNode, nextValueNode: REF] = {
                IF GetNodeName[declNode] = $DECL
                    THEN {
                        Assert[AnalyzeDecl[innerContext, declNode, self, 1]];
                        Assert[AnalyzeDecl[innerContext, declNode, self, 2]];
                        Assert[AnalyzeDecl[innerContext, declNode, self, 3]];
                        PropagateAttribute[initValueNode, $NEEDTYPECODE, NARROW[declNode], $DECLTYPECODE];
                        }
                    ELSE {
                        AddAttribute[NARROW[declNode], $VAR, $TRUE];
                        Assert[AnalyzeExpression[innerContext, declNode]];
                        PropagateAttribute[initValueNode, $NEEDTYPECODE, NARROW[declNode], $TYPECODE];
                        };
                Assert[AnalyzeExpression[context, initValueNode]];
                IF nextValueNode # NIL THEN {
                    PropagateAttribute[nextValueNode, $NEEDTYPECODE, NARROW[initValueNode], $NEEDTYPECODE];
                    Assert[AnalyzeExpression[innerContext, nextValueNode]];
                    };
                };
            Thru: PROC [declNode, rangeNode, whatsthisNode: REF] = {
                needType: TypeCode Ź nullTypeCode;
                Assert[whatsthisNode=NIL];
                IF declNode # NIL THEN {
                    IF GetNodeName[declNode] = $DECL
                        THEN {
                            Assert[AnalyzeDecl[innerContext, declNode, self, 1]];
                            Assert[AnalyzeDecl[innerContext, declNode, self, 2]];
                            Assert[AnalyzeDecl[innerContext, declNode, self, 3]];
                            needType Ź GetTypeCodeAttribute[declNode, $DECLTYPECODE];
                            }
                        ELSE {
                            AddAttribute[NARROW[declNode], $VAR, $TRUE];
                            Assert[AnalyzeExpression[innerContext, declNode]];
                            needType Ź GetTypeCodeAttribute[declNode, $TYPECODE];
                            };
                    };
                AnalyzeInterval[innerContext, rangeNode, needType];
                };
            Assert[analyzeStatement AND whatsitNode=NIL AND huhNode=NIL AND whyNode=NIL, "Unimplemented loop construct",,self];
            Assert[iterationControlNode = NIL OR With3[iterationControlNode, forseq, ForSeq] OR With3[iterationControlNode, upthru, Thru] OR 
            With3[iterationControlNode, downthru, Thru]];
            IF terminationTestNode # NIL THEN {
                AddTypeCodeAttribute[terminationTestNode, $NEEDTYPECODE, LookupTypeCode[Root[innerContext], "BOOL"]];
                Assert[AnalyzeExpression[innerContext, terminationTestNode]];
                };
            DoList[loopBodyNode, EachStatement];
            };
        Return: PROC [returnValuesNode: REF] = {
            IF returnValuesNode # NIL THEN {
                fieldList: FieldList Ź NIL;
                keywordOperands: BOOL Ź FALSE;
                positionalOperands: BOOL Ź FALSE;
                EachReturnValue: PROC [returnValueItemNode: REF] = {
                    Named: PROC [nameNode, exprNode: REF] = {
                        id: ROPE = GetIdentifier[nameNode];
                        keywordOperands Ź TRUE;
                        Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
                        FOR each: FieldList Ź fieldList, each.rest UNTIL each = NIL DO
                            IF Rope.Equal[each.first.name, id, TRUE] THEN {
                                AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, each.first.rangeType];
                                Assert[AnalyzeExpression[context, exprNode]];
                                RETURN;
                                };
                            ENDLOOP;
                        Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
                        };
                    IF NOT With2[returnValueItemNode, item, Named] THEN {
                        positionalOperands Ź TRUE;
                        Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
                        IF fieldList = NIL
                            THEN { [] Ź Help["Too many items in group",,self] }
                            ELSE {
                                AddTypeCodeAttribute[returnValueItemNode, $NEEDTYPECODE, fieldList.first.rangeType];
                                Assert[AnalyzeExpression[context, returnValueItemNode], "Expr expected in returnValuesNode",, tree];
                                fieldList Ź fieldList.rest;
                                };
                        };
                    };
                WITH LookupSymbol[context, IF GetNodeName[self] = $RETURN THEN "*RETURN-VALUE*" ELSE "*RESUME-VALUE*"] SELECT FROM
                    ste: REF SymbolTableEntryRep.other => {
                        WITH UnderType[context.types, ste.typeCode] SELECT FROM
                            r: REF TypeRep.record => fieldList Ź r.fieldList;
                            ENDCASE => NULL;
                        };
                    ENDCASE => Assert[FALSE, "No return value expected here",,self];
                DoList[returnValuesNode, EachReturnValue];
                };
            };
        Case: PROC [exprNode, caseListNode, endcaseNode: REF] = {
            needTypeCode: TypeCode Ź GetTypeCodeAttribute[self, $NEEDTYPECODE];
            first: BOOL Ź TRUE;
            booleanTypeCode: TypeCode = LookupTypeCode[Root[context], "BOOL"];
            EachCase: PROC [itemNode: Tree] = {
                DoItem: PROC [conditionNode, choosesNode: REF] = {
                    EachCond: PROC [condItemNode: Tree] = {
                        AddTypeCodeAttribute[condItemNode, $NEEDTYPECODE, booleanTypeCode];
                        Assert[AnalyzeExpression[context, condItemNode
                            ! GetLeftRelOperand => { RESUME[exprNode] }
                            ], "Expr expected",, condItemNode];
                        };
                    DoList[conditionNode, EachCond];
                    IF NOT analyzeStatement THEN AddTypeCodeAttribute[choosesNode, $NEEDTYPECODE, needTypeCode];
                    Assert[AnalyzeExpressionOrStatement[context, choosesNode, analyzeStatement],,,choosesNode];
                    IF NOT analyzeStatement AND first AND needTypeCode = nullTypeCode THEN {
                        needTypeCode Ź GetTypeCodeAttribute[choosesNode, $TYPECODE];
                        };
                    first Ź FALSE;
                    };
                Assert[With2[itemNode, item, DoItem], "Item expected",, itemNode];
                };
            Assert[AnalyzeExpression[context, exprNode]];
            DoList[caseListNode, EachCase];
            IF NOT analyzeStatement THEN AddTypeCodeAttribute[endcaseNode, $NEEDTYPECODE, needTypeCode];
            Assert[AnalyzeExpressionOrStatement[context, endcaseNode, analyzeStatement],,,endcaseNode];
            IF NOT analyzeStatement THEN AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
            };
        Bind: PROC [selectOnNode, whatsitNode, caseListNode, endcaseNode: REF] = {
            needTypeCode: TypeCode Ź GetTypeCodeAttribute[self, $NEEDTYPECODE];
            first: BOOL Ź TRUE;
            unsafeSelectID: ROPE Ź NIL;
            unsafeSelectType: Type Ź NIL;
            SelectOn: PROC [renameNode, exprNode: REF] = {
                Assert[AnalyzeExpression[context, exprNode]];
                IF renameNode # NIL THEN {
                    unsafeSelectID Ź GetIdentifier[renameNode];
                    unsafeSelectType Ź UnderType[context.types, GetTypeCodeAttribute[exprNode]];
                    };
                };
            CaseList: PROC [selectBranchItemNode: Tree] = {
                SelectBranchItem: PROC [declNode, choosesNode: REF] = {
                    innerContext: Context = NewContext[context];
                    IF unsafeSelectType # NIL 
                        THEN {
                            q: TypeCode = QualifyVariant[context.types, unsafeSelectType.typeCode, GetIdentifier[declNode]];
                            AddSymbol[context: innerContext, id: unsafeSelectID, val: NEW[SymbolTableEntryRep.other Ź [other[typeCode: q, readonly: TRUE]]]];
                            }
                        ELSE {
                            Assert[AnalyzeDecl[innerContext, declNode, NIL, 1], "Decl expected",,declNode];
                            [] Ź AnalyzeDecl[innerContext, declNode, NIL, 2];
                            [] Ź AnalyzeDecl[innerContext, declNode, NIL, 3];
                            };
                    IF NOT analyzeStatement THEN AddTypeCodeAttribute[choosesNode, $NEEDTYPECODE, needTypeCode];
                    Assert[AnalyzeExpressionOrStatement[innerContext, choosesNode, analyzeStatement],,,choosesNode];
                    IF NOT analyzeStatement AND first AND needTypeCode = nullTypeCode THEN {
                        needTypeCode Ź GetTypeCodeAttribute[choosesNode, $TYPECODE];
                        };
                    };
                Assert[With2[selectBranchItemNode, item, SelectBranchItem]];
                };
            Assert[With2[selectOnNode, item, SelectOn]];
            Assert[whatsitNode=NIL,"What's the second node mean?",,self];
            DoList[caseListNode, CaseList];
            Assert[AnalyzeExpressionOrStatement[context, endcaseNode, analyzeStatement],,,endcaseNode];
            IF NOT analyzeStatement THEN AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
            };
        Assign: PROC [lhsNode, rhsNode: REF] = {
            AddAttribute[NARROW[lhsNode], $VAR, $TRUE];
            Assert[AnalyzeExpression[context, lhsNode]];
            PropagateAttribute[rhsNode, $NEEDTYPECODE, NARROW[lhsNode], $TYPECODE];
            WITH UnderType[context.types, GetTypeCodeAttribute[lhsNode]] SELECT FROM
                t: REF TypeRep => {
                    AddAttribute[self, $ASSIGNTYPECLASS, t.class];
                    IF t.class = $RECORD THEN {
                        AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[lhsNode], FALSE]];
                        };
                    };
                ENDCASE => NULL;
            Assert[AnalyzeExpression[context, rhsNode]];
            IF NOT analyzeStatement THEN PropagateAttribute[self, $TYPECODE, NARROW[lhsNode], $TYPECODE];
            };
        Extract: PROC [lhsNode, rhsNode: REF] = {
            keywordOperands: BOOL Ź FALSE;
            positionalOperands: BOOL Ź FALSE;
            fieldList: FieldList Ź NIL;
            AnalyzeDest: PROC [destNode: REF, typeCode: TypeCode] = {
                AddAttribute[NARROW[destNode], $VAR, $TRUE];
                AddTypeCodeAttribute[destNode, $NEEDTYPECODE, typeCode];
                Assert[AnalyzeExpression[context, destNode]];
                };
            Each: PROC [lhsElementNode: REF] = {
                Named: PROC [nameNode, destNode: REF] = {
                    id: ROPE = GetIdentifier[nameNode];
                    keywordOperands Ź TRUE;
                    Assert[NOT positionalOperands, "Mixed keyword/positional notation",, tree];
                    FOR each: FieldList Ź fieldList, each.rest UNTIL each = NIL DO
                        IF Rope.Equal[each.first.name, id, TRUE] THEN {
                            AnalyzeDest[destNode, each.first.rangeType];
                            RETURN;
                            };
                        ENDLOOP;
                    Assert[FALSE, "Unknown field name: %g", [rope[id]], self];
                    };
                IF lhsElementNode = NIL OR NOT With2[lhsElementNode, item, Named] THEN {
                    positionalOperands Ź TRUE;
                    Assert[NOT keywordOperands, "Mixed keyword/positional notation",, tree];
                    IF fieldList = NIL
                        THEN { [] Ź Help["Too many items in group",,self] }
                        ELSE {
                            IF lhsElementNode # NIL THEN AnalyzeDest[lhsElementNode, fieldList.first.rangeType];
                            fieldList Ź fieldList.rest;
                            };
                    };
                };
            Assert[AnalyzeExpression[context, rhsNode]];
            fieldList Ź GetConstructorFieldList[context, GetTypeCodeAttribute[rhsNode]];
            DoList[lhsNode, Each];
            IF NOT analyzeStatement THEN PropagateAttribute[self, $TYPECODE, NARROW[rhsNode], $TYPECODE];
            };
        Unary: PROC [operandNode: REF] = {
            AssertNotVar[self];
            PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            Assert[AnalyzeExpression[context, operandNode]];
            PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $TYPECODE];
            };
        BinaryOp: PROC [aNode, bNode: REF] = {
            aClass, bClass, dClass: NumericTypeClass Ź nonnumeric;
            AssertNotVar[self];
            Assert[AnalyzeExpression[context, aNode]];
            Assert[AnalyzeExpression[context, bNode]];
            aClass Ź NumericTypeClassOf[context.types, GetTypeCodeAttribute[aNode]];
            bClass Ź NumericTypeClassOf[context.types, GetTypeCodeAttribute[bNode]];
            dClass Ź NumericTypeClassOf[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]];
            IF self.syntaxNodeName = $PLUS OR self.syntaxNodeName = $MINUS THEN {
                IF aClass = unspecified AND bClass = unspecified THEN {
                    PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
                    RETURN;
                    };
                IF aClass = unspecified THEN {
                    PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
                    RETURN;
                    };
                IF bClass = unspecified THEN {
                    PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
                    RETURN;
                    };
                IF warnPointerArith AND aClass = pointer THEN Assert[true: FALSE, format: "warning: Pointer arithmetic", tree: self];
                SELECT aClass FROM
                    pointer, char => {
                        IF bClass IN [signed..unsigned] THEN {
                            PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
                            RETURN;
                            };
                        IF bClass = aClass AND self.syntaxNodeName = $MINUS THEN {
                            AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "INT"]];
                            RETURN;
                            };
                        };
                    ENDCASE => NULL;
                IF self.syntaxNodeName = $PLUS THEN SELECT bClass FROM
                    pointer, char => {
                        IF aClass IN [signed..unsigned] THEN {
                            PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
                            RETURN;
                            };
                        };
                    ENDCASE => NULL;
                };
            Assert[aClass IN [signed..real] AND bClass IN [signed..real], "Can't do arithmetic with this type",,self];
            IF aClass # real AND bClass # real AND self.syntaxNodeName = $DIV THEN {
                self.syntaxNodeName Ź $IDIV
                };
            IF aClass = real OR bClass = real OR dClass = real
                THEN {
                    realCode: TypeCode = LookupTypeCode[Root[context], "REAL"];
                    AddAttribute[self, $ARITHTYPE, $REAL];
                    IF aClass # real THEN {
                        AddAttribute[NARROW[aNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[aNode], to: realCode, tree: aNode]];
                        };
                    IF bClass # real THEN {
                        AddAttribute[NARROW[bNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[bNode], to: realCode, tree: bNode]];
                        };
                    AddTypeCodeAttribute[self, $TYPECODE, realCode];
                    }
                ELSE {
                    IF self.syntaxNodeName = $DIV THEN self.syntaxNodeName Ź $IDIV;
                    PropagateAttribute[self, $TYPECODE, NARROW[aNode], $TYPECODE];
                    };
            };
        BinaryBoolOp: PROC [aNode, bNode: REF] = {
            AssertNotVar[self];
            PropagateAttribute[aNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            Assert[AnalyzeExpression[context, aNode]];
            PropagateAttribute[bNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
            Assert[AnalyzeExpression[context, bNode]];
            PropagateAttribute[self, $TYPECODE, NARROW[bNode], $TYPECODE];
            };
        RelOp: PROC [aNode, bNode: REF] = {
            typeCode: TypeCode Ź nullTypeCode;
            aClass, bClass: NumericTypeClass Ź nonnumeric;
            AssertNotVar[self];
            IF aNode = NIL
                THEN {
                    <<If aNode is NIL, we are probably inside a case or casex, and need to get aNode from above.  In this case, it has already been 
                    analyzed.>>
                    aNode Ź SIGNAL GetLeftRelOperand[];
                    }
                ELSE Assert[AnalyzeExpression[context, aNode]];
            typeCode Ź GetTypeCodeAttribute[aNode, $TYPECODE];
            WITH UnderType[context.types, typeCode] SELECT FROM
                t: REF TypeRep.record => {
                    IF t.class = $STRUCTURE AND t.fieldList # NIL AND t.fieldList.rest = NIL
                        THEN {
                            <<one-component structure; try coercion to element type>>
                            typeCode Ź t.fieldList.first.rangeType
                            };
                    };
                ENDCASE => NULL;
            WITH UnderType[context.types, typeCode] SELECT FROM
                t: REF TypeRep.scalar => NULL;
                ENDCASE => AddTypeCodeAttribute[bNode, $NEEDTYPECODE, typeCode];
            Assert[AnalyzeExpression[context, bNode]];
            aClass Ź NumericTypeClassOf[context.types, GetTypeCodeAttribute[aNode]];
            bClass Ź NumericTypeClassOf[context.types, GetTypeCodeAttribute[bNode]];
            IF aClass = real OR bClass = real
                THEN {
                    realCode: TypeCode = LookupTypeCode[Root[context], "REAL"];
                    AddAttribute[self, $COMPARETYPE, $REAL];
                    IF aClass # real THEN {
                        AddAttribute[NARROW[aNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[aNode], to: realCode, tree: aNode]];
                        };
                    IF bClass # real THEN {
                        AddAttribute[NARROW[bNode], $COERCIONS, Coercions[context: context, from: GetTypeCodeAttribute[bNode], to: realCode, tree: bNode]];
                        };
                    }
                ELSE {
                    ct: ATOM Ź NIL;
                    SELECT TRUE FROM
                        aClass IN [signed..unsigned] AND aClass IN [signed..unsigned] => ct Ź $INTEGER;
                        aClass = unspecified OR bClass = unspecified => ct Ź $UNSPECIFIED;
                        aClass = pointer AND bClass = pointer => ct Ź $POINTER;
                        aClass = reference AND bClass = reference => ct Ź $POINTER;
                        aClass = char AND bClass = char => ct Ź $CHAR;
                        aClass = enumeration AND bClass = enumeration => ct Ź $ENUMERATION;
                        aClass = nonnumeric AND bClass = nonnumeric => ct Ź $COMPOSITE;
                        ENDCASE => Assert[FALSE, "Bad comparison",,self];
                    IF ct # NIL THEN AddAttribute[self, $COMPARETYPE, ct];
                    };
            AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "BOOL"]];
            };
        All: PROC [operandNode: REF] = {
            AssertNotVar[self];
            WITH UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]] SELECT FROM
                t: REF TypeRep.array => {
                    AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, t.rangeType];
                    Assert[AnalyzeExpression[context, operandNode]];
                    AddTypeCodeAttribute[self, $TYPECODE, t.typeCode];
                    };
                ENDCASE => Assert[FALSE, "ALL's not well here",, self];
            };
        In: PROC [exprNode, rangeNode: REF] = {
            typeCode: TypeCode Ź nullTypeCode;
            AssertNotVar[self];
            IF exprNode = NIL
                THEN {
                    <<If exprNode is NIL, we are probably inside a case or casex, and need to get aNode from above.  In this case, it has already been 
                    analyzed.>>
                    exprNode Ź SIGNAL GetLeftRelOperand[];
                    }
                ELSE Assert[AnalyzeExpression[context, exprNode]];
            typeCode Ź GetTypeCodeAttribute[exprNode, $TYPECODE];
            WITH UnderType[context.types, typeCode] SELECT FROM
                t: REF TypeRep.record => {
                    IF t.fieldList # NIL AND t.fieldList.rest = NIL
                        THEN {
                            <<one-component structure; try coercion to element type>>
                            typeCode Ź t.fieldList.first.rangeType
                            };
                    };
                ENDCASE => NULL;
            AnalyzeInterval[context, rangeNode, typeCode];
            AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "BOOL"]];
            };
        Dot: PROC [leftNode, rightNode: REF] = {
            id: ROPE Ź GetIdentifier[rightNode];
            dereferenceCount: NAT Ź 0;
            leftTypeCode: TypeCode Ź nullTypeCode;
            Assert[AnalyzeExpression[context, leftNode]];
            leftTypeCode Ź GetTypeCodeAttribute[leftNode];
            DO
                WITH UnderType[context.types, leftTypeCode] SELECT FROM
                    t: REF TypeRep.type => {
                        WITH UnderType[context.types, t.value] SELECT FROM
                            et: REF TypeRep.enumerated => {
                                WITH rightNode SELECT FROM
                                    a: AttributedNode => {
                                        a.syntaxNodeName Ź $ENUMERATIONLITERAL;
                                        AddTypeCodeAttribute[a, $TYPECODE, t.value];
                                        AddAttribute[a, $FROM, GetTypeName[context, t.value, FALSE]];
                                        self.syntaxNodeName Ź $ENUMERATIONSELECT;
                                        AddTypeCodeAttribute[self, $TYPECODE, t.value];
                                        };
                                    ENDCASE => ERROR;
                                };
                            ENDCASE => {
                                q: TypeCode = QualifyVariant[context.types, t.value, id];
                                self.syntaxNodeName Ź $DISCRIMINATE;
                                AddTypeCodeAttribute[self, $TYPECODE, NewTypeType[context.types, q]];
                                };
                        RETURN;
                        };
                    t: REF TypeRep.record => {
                        IF FieldSelect[context, self, leftTypeCode, t, id, dereferenceCount] THEN {
                            IF t.class = $DEFINITIONS THEN {
                                QualifyIdentifierNode[rightNode, GetUnderQualifier[context, GetIdentifier[leftNode], id, GetTypeCodeAttribute[self]]];
                                };
                            RETURN;
                            };
                        IF t.fieldList # NIL AND t.fieldList.rest = NIL
                            THEN {
                                <<one-component structure; try coercion to element type>>
                                leftTypeCode Ź t.fieldList.first.rangeType
                                }
                             ELSE EXIT;
                        };
                    t: REF TypeRep.qualifiedVariant => {
                        IF FieldSelect[context, self, leftTypeCode, t, id, dereferenceCount] THEN RETURN ELSE EXIT;
                        };
                    t: REF TypeRep.simple => {
                        IF t.class = $OPAQUE
                            THEN {
                                concrete: TypeCode = GetConcreteTypeCode[context, t.typeCode];
                                IF concrete = nullTypeCode THEN EXIT ELSE leftTypeCode Ź concrete;
                                }
                            ELSE EXIT;
                        };
                    t: REF TypeRep.reference => {
                        leftTypeCode Ź t.referentType; -- try some dereferencing
                        dereferenceCount Ź dereferenceCount + 1;
                        };
                    t: REF TypeRep.control => {
                        IF NARROW[leftNode, AttributedNode].syntaxNodeName = $FUNKYAPPLY
                            THEN { leftTypeCode Ź t.returnType }
                            ELSE EXIT;
                        };
                    ENDCASE => EXIT;
                ENDLOOP;
            <<It is not a type or a structure or a reference to a structure, so it must be object notation.>>
            WITH GetTypeName[context, GetTypeCodeAttribute[leftNode], FALSE] SELECT FROM
                l: LIST OF REF => {
                    WITH LookupSymbol[context, NARROW[l.first]] SELECT FROM
                        ste: REF SymbolTableEntryRep.directory => {
                            Action: PROC [fieldIndex: INT, fieldName: ROPE, fieldTypeCode: TypeCode, tagName: ROPE, tagTypeCode: TypeCode] RETURNS [quit: BOOL 
                            Ź FALSE] = {
                                Assert[tagTypeCode=nullTypeCode];
                                IF Rope.Equal[fieldName, id] THEN {
                                    use: BOOL Ź NOT ste.hasUsing;
                                    FOR u: LIST OF ROPE Ź ste.using, u.rest UNTIL use OR u=NIL DO
                                        use Ź Rope.Equal[id, u.first];
                                        ENDLOOP;
                                    IF use THEN {
                                        WITH UnderType[context.types, fieldTypeCode] SELECT FROM
                                            p: REF TypeRep.control => {
                                                WITH UnderType[context.types, p.argumentType] SELECT FROM
                                                    s: REF TypeRep.record => {
                                                        IF s.fieldList # NIL THEN {
                                                            <<Should make sure that leftNode type is compatible with s.fieldList.first.rangeType>>
                                                            newArgumentType: TypeCode = NewType[context.types, NEW[TypeRep.record Ź [class: $STRUCTURE, v: record[fieldList: 
                                                            s.fieldList.rest]]]];
                                                            procTypeCode: TypeCode = NewType[context.types, NEW[TypeRep.control Ź [class: $PROC, v: control[argumentType: newArgumentType, 
                                                            returnType: p.returnType]]]];
                                                            self.syntaxNodeName Ź $FUNKYAPPLY;
                                                            QualifyIdentifierNode[rightNode, NARROW[l.first]];
                                                            AddAttribute[self, $FROMINTERFACE, l.first];
                                                            AddTypeCodeAttribute[self, $TYPECODE, procTypeCode];
                                                            RETURN [TRUE];
                                                            };
                                                        };
                                                    ENDCASE => NULL;
                                                };
                                            ENDCASE => NULL;
                                        };
                                    };
                                };
                            IF ste.interfaceRecordType # NIL AND EnumerateFields[context.types, ste.interfaceRecordType.typeCode, Action] THEN RETURN;
                            };
                        ENDCASE => NULL;
                    };
                ENDCASE => NULL;
            [] Ź Help["Unable to deciper this dot notation",,self];
            };
        Addr: PROC [operandNode: REF] = {
            AddAttribute[NARROW[operandNode], $VAR, $TRUE];
            WITH UnderType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]] SELECT FROM
                t: REF TypeRep.reference => {AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, t.referentType]};
                ENDCASE => NULL;
            Assert[AnalyzeExpression[context, operandNode]];
            IF GetTypeCodeAttribute[self, $NEEDTYPECODE] # nullTypeCode
                THEN { PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE] }
                ELSE {
                    AddTypeCodeAttribute[self, $TYPECODE, NewReferenceType[typeGraph: context.types, referentType: GetTypeCodeAttribute[operandNode], 
                    class: $LONGPOINTER]];
                    };
            };
        Uparrow: PROC [operandNode: REF] = {
            Assert[AnalyzeExpression[context, operandNode]];
            WITH UnderType[context.types, GetTypeCodeAttribute[operandNode]] SELECT FROM
                t: REF TypeRep.reference => {AddTypeCodeAttribute[self, $TYPECODE, t.referentType]};
                ENDCASE => Assert[FALSE, "Reference type required here",, operandNode];
            };
        MinMax: PROC [listNode: REF] = {
            needTypeCode: TypeCode Ź GetTypeCodeAttribute[self, $NEEDTYPECODE];
            first: BOOL Ź TRUE;
            EachOperand: PROC [operandNode: REF] = {
                AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, needTypeCode];
                Assert[AnalyzeExpression[context, operandNode]];
                IF first THEN {
                    needTypeCode Ź GetTypeCodeAttribute[operandNode, $TYPECODE];
                    first Ź FALSE;
                    };
                };
            AssertNotVar[self];
            DoList[listNode, EachOperand];
            AddTypeCodeAttribute[self, $TYPECODE, needTypeCode];
            };
        Lengthen: PROC [operandNode: REF] = {
            typeCode: TypeCode Ź GetTypeCodeAttribute[self, $NEEDTYPECODE];
            IF typeCode # nullTypeCode THEN {
                <<typeCode _ LengthenTypeCode[context, typeCode]; do this later>>
                AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, typeCode];
                };
            Assert[AnalyzeExpression[context, operandNode]];
            typeCode Ź GetTypeCodeAttribute[operandNode, $TYPECODE];
            <<typeCode _ LengthenTypeCode[context, typeCode]; do this later>>
            AddTypeCodeAttribute[self, $TYPECODE, typeCode];
            };
        Size: PROC [typeNode, packingNode: REF] = {
            AssertNotVar[self];
            AddAttribute[NARROW[typeNode], $SIZEORNEW, $TRUE];
            AnalyzeType[context, typeNode];
            IF packingNode # NIL THEN {
                AddTypeCodeAttribute[packingNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "INT"]];
                Assert[AnalyzeExpression[context, packingNode]];
                };
            AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "INT"]];
            };
        FirstLast: PROC [typeNode: REF] = {
            AnalyzeType[context, typeNode];
            AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
            WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]] SELECT FROM
                t: REF TypeRep.subrange => NULL;
                t: REF TypeRep.scalar => NULL;
                t: REF TypeRep.enumerated => NULL;
                ENDCASE => Assert[FALSE, "Scalar, subrange, or enumeration type required here",, typeNode];
            };
        Narrow: PROC [exprNode, typeNode: REF] = {
            Assert[AnalyzeExpression[context, exprNode]];
            IF typeNode = NIL
                THEN {
                    PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
                    }
                ELSE {
                    AnalyzeType[context, typeNode];
                    AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
                    };
            };
        Nil: PROC [typeNode: REF] = {
            IF typeNode = NIL
                THEN {PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE]}
                ELSE {
                    AnalyzeType[context, typeNode];
                    AddTypeCodeAttribute[self, $TYPECODE, GetTypeValueAttribute[context.types, typeNode]];
                    WITH UnderType[context.types, GetTypeValueAttribute[context.types, typeNode]] SELECT FROM
                        t: REF TypeRep.reference => NULL;
                        ENDCASE => Assert[FALSE, "Reference type required here",, typeNode];
                    };
            };
        New: PROC [zoneNode, typeNode, valueNode: REF] = {
            AssertNotVar[self];
            AddAttribute[NARROW[typeNode], $SIZEORNEW, $TRUE];
            AnalyzeType[context, typeNode];
            IF valueNode # NIL THEN {
                AddTypeCodeAttribute[valueNode, $NEEDTYPECODE, GetTypeValueAttribute[context.types, typeNode]];
                Assert[AnalyzeExpression[context, valueNode]];
                };
            AddTypeCodeAttribute[self, $TYPECODE, NewReferenceType[context.types, GetTypeValueAttribute[context.types, typeNode], $REF]];
            };
        CharLit: PROC [exprNode: REF] = {
            AddTypeCodeAttribute[exprNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "CHAR"]];
            Assert[AnalyzeExpression[context, exprNode]];
            AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], "CHAR"]];
            };
        Cons: PROC [zoneNode, argListNode: REF] = {
            ArgList: PROC [newElementNode, oldListNode: REF] = {
                listTypeCode: TypeCode = GetTypeCodeAttribute[self, $NEEDTYPECODE];
                elementTypeCode: TypeCode = GetListElementTypeCode[context.types, listTypeCode];
                AddTypeCodeAttribute[newElementNode, $NEEDTYPECODE, elementTypeCode];
                Assert[AnalyzeExpression[context, newElementNode]];
                AddTypeCodeAttribute[oldListNode, $NEEDTYPECODE, listTypeCode];
                Assert[AnalyzeExpression[context, oldListNode]];
                };
            Assert[With2[argListNode, list, ArgList], "CONS takes two arguments",,self];
            };
        Atom: PROC [operandNode: REF] = {
            AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "ATOM"]];
            Assert[AnalyzeExpression[context, operandNode]];
            PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $NEEDTYPECODE];
            };
        Cast: PROC [operandNode: REF] = {
            IF operandNode # NIL THEN {
                PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
                Assert[AnalyzeExpression[context, operandNode]];
                PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
                };
            };
        Float: PROC [operandNode: REF] = {
            AddTypeCodeAttribute[operandNode, $NEEDTYPECODE, LookupTypeCode[Root[context], "REAL"]];
            Assert[AnalyzeExpression[context, operandNode]];
            PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $NEEDTYPECODE];
            };
        Ord: PROC [operandNode: REF] = {
            Assert[AnalyzeExpression[context, operandNode]];
            PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
            };
        MWConst: PROC [operandNode: REF] = {
            IF operandNode # NIL THEN {
                PropagateAttribute[operandNode, $NEEDTYPECODE, self, $NEEDTYPECODE];
                Assert[AnalyzeExpression[context, operandNode]];
                PropagateAttribute[self, $TYPECODE, NARROW[operandNode], $TYPECODE];
                };
            };
        Identifier: PROC [id: ROPE] = {
            WITH BaseType[context.types, GetTypeCodeAttribute[self, $NEEDTYPECODE]] SELECT FROM
                t: REF TypeRep.enumerated => {
                    FOR each: LIST OF EnumerationItem Ź t.items, each.rest UNTIL each = NIL DO
                        IF Rope.Equal[each.first.name, id] THEN {
                            AssertNotVar[self];
                            PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
                            self.syntaxNodeName Ź $ENUMERATIONLITERAL;
                            AddAttribute[self, $FROM, GetTypeName[context, GetTypeCodeAttribute[self, $NEEDTYPECODE], FALSE]];
                            AddAttribute[self, $ORDINALVALUE, NEW[CARD Ź each.first.value]];
                            RETURN;
                            };
                        ENDLOOP;
                    };
                ENDCASE => NULL;
            WITH LookupSymbol[context, id] SELECT FROM
                ste: REF SymbolTableEntryRep.directory => {
                    AssertNotVar[self];
                    AddTypeCodeAttribute[self, $TYPECODE, ste.interfaceRecordType.typeCode];
                    };
                ste: REF SymbolTableEntryRep.other => {
                    IF ste.readonly THEN AssertNotVar[self];
                    AddTypeCodeAttribute[self, $TYPECODE, ste.typeCode];
                    QualifyIdentifierNode[self, ste.qualifier];
                    };
                ENDCASE => Assert[FALSE, "Identifier not an expression: %g", [rope[id]], self];
            };
        Enable: PROC [catchNode, statementNode: REF] = {
            IF catchNode # NIL THEN Assert[With2[catchNode, catch, Catch]];
            AnalyzeStatement[context, statementNode];
            };
        Label: PROC [statementNode, itemsNode: REF] = {
            LabelItem: PROC [itemNode: REF] = {
                LabelledStatement: PROC [labelNode, labelledStatementNode: REF] = {
                    AnalyzeStatement[context, labelledStatementNode];
                    };
                Assert[With2[itemNode, item, LabelledStatement], "???",,itemsNode];
                };
            AnalyzeStatement[context, statementNode];
            DoList[itemsNode, LabelItem];
            };
        Catch: PROC [itemNode, whatsitNode: REF] = {
            CatchItem: PROC [signalNode, statementNode: REF] = {
                innerContext: Context Ź context;
                IF GetNodeName[signalNode] = $ID AND Rope.Equal[GetIdentifier[signalNode], "UNWIND"]
                    THEN NULL
                    ELSE {
                        IF AnalyzeExpression[context, signalNode] THEN {
                            signalTypeCode: TypeCode = GetTypeCodeAttribute[signalNode];
                            innerContext Ź NewContext[context];
                            WITH UnderType[context.types, signalTypeCode] SELECT FROM
                                type: REF TypeRep.control => {
                                    WITH UnderType[context.types, type.argumentType] SELECT FROM
                                        arguments: REF TypeRep.record => {
                                            AddFieldListToContext[innerContext, arguments.fieldList];
                                                <<-- makes the names of the arguments known within the body.>>
                                            };
                                        ENDCASE => NULL;
                                    IF type.class = $SIGNAL THEN {
                                        WITH UnderType[context.types, type.returnType] SELECT FROM
                                            returns: REF TypeRep.record => {
                                                AddSymbol[innerContext, "*RESUME-VALUE*", NEW[SymbolTableEntryRep.other Ź [other[typeCode: type.returnType, readonly: FALSE, 
                                                constantValue: NIL]]]];
                                                AddFieldListToContext[innerContext, returns.fieldList];
                                                };
                                            ENDCASE => NULL;
                                        };
                                    };
                                ENDCASE => NULL;
                            };
                        };
                AnalyzeStatement[innerContext, statementNode];
                };
            Assert[whatsitNode = NIL, "whatsit?",,whatsitNode];
            Assert[With2[itemNode, item, CatchItem], "Bad catch",,self];
            };
        Literal: PROC [literal: REF MPLeaves.LTNode] = {
            <<Should do some checking here.>>
            typeName: ROPE Ź NIL;
            WITH literal.value SELECT FROM
                r: REF REAL => typeName Ź "REAL";
                r: REF DREAL => typeName Ź "DREAL";
                r: REF INT => typeName Ź "INT32";
                r: REF DINT => IF r­ IN INT32 THEN typeName Ź "INT32" ELSE IF r­ IN DINT[0..CARD32.LAST] THEN typeName Ź "CARD32" ELSE typeName Ź 
                "DINT";
                r: REF CARD => typeName Ź "CARD32";
                r: REF DCARD => IF r­ IN CARD32 THEN typeName Ź "CARD32" ELSE typeName Ź "DCARD";
                r: REF CHAR => typeName Ź "CHAR";
                ENDCASE => NULL;
            IF typeName # NIL
                THEN {AddTypeCodeAttribute[self, $TYPECODE, LookupTypeCode[Root[context], typeName]]}
                ELSE {PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE]};
            };
        IF analyzeStatement
            THEN {
                Oops: PROC = {
                    [] Ź Help["Unimplemented statement kind: %g", [refAny[GetNodeName[self]]], self];
                    };
                EachStatement: PROC [item: Tree] = { AnalyzeStatement[context, item] };
                IF self = NIL THEN RETURN [TRUE];
                IF GetNodeName[self] = $ID THEN {
                    <<Should be a proc (or signal or error) with no arguments.>>
                    FunnyApply[self];
                    <<Should inspect GetAttribute[self, $TYPECODE];>>
                    RETURN [TRUE]
                    };
                IF WithId[self, Identifier] THEN {
                    <<Should check that this is a proc (or signal or error) with no arguments.>>
                    RETURN [TRUE]
                    };
                SELECT GetNodeNameCode[self] FROM
                    void => NULL;
                    list => DoList[self, EachStatement];
                    block => AnalyzeBlockOrBody[context, self];
                    body => AnalyzeBlockOrBody[context, self];
                    apply => DoWith3[self, Apply];
                    assign => DoWith2[self, Assign];
                    extract => DoWith2[self, Extract];
                    if => DoWith3[self, If];
                    case => DoWith3[self, Case];
                    bind => DoWith4[self, Bind];
                    do => DoWith6[self, Do];
                    return => DoWith1[self, Return];
                    result => Oops[];
                    goto => NULL;
                    exit => NULL;
                    loop => NULL;
                    free => Oops[];
                    resume => DoWith1[self, Return];
                    reject => NULL;
                    continue => NULL;
                    retry => Oops[];
                    lock, wait, notify, broadcast, unlock => Oops[];
                    null => NULL;
                    label => DoWith2[self, Label];
                    open => AnalyzeBlockOrBody[context, self];
                    enable => DoWith2[self, Enable];
                    dst, lst, lstf => Oops[];
                    syscall => NULL;
                    checked => DoWith1[self, EachStatement];
                    subst, call, portcall => Oops[];
                    signal => DoWith1[self, FunnyApply];
                    error => DoWith1[self, FunnyApply];
                    syserror => NULL;
                    xerror => DoWith1[self, FunnyApply];
                    start, join => Oops[];
                    ENDCASE => RETURN [FALSE];
                RETURN [TRUE]
                }
            ELSE {
                Oops: PROC = {
                    [] Ź Help["Unimplemented expression kind: %g", [refAny[GetNodeName[self]]], self];
                    };
                IF NOT (WithId[self, Identifier] OR WithLiteral[self, Literal]) THEN {
                    SELECT GetNodeNameCode[self] FROM
                        apply => DoWith3[self, Apply];
                        errorx => DoWith1[self, FunnyApply];
                        syserrorx => NULL;
                        callx, portcallx, signalx, startx, fork, joinx => Oops[];
                        index, dindex, seqindex, reloc => Oops[];
                        construct, union, rowcons, sequence => Oops[];
                        listcons => DoWith2[self, ListCons];
                        substx => Oops[];
                        ifx => DoWith3[self, If];
                        casex => DoWith3[self, Case];
                        bindx => DoWith4[self, Bind];
                        assignx => DoWith2[self, Assign];
                        or => DoWith2[self, BinaryBoolOp];
                        and => DoWith2[self, BinaryBoolOp];
                        relE => DoWith2[self, RelOp];
                        relN => DoWith2[self, RelOp];
                        relL => DoWith2[self, RelOp];
                        relGE => DoWith2[self, RelOp];
                        relG => DoWith2[self, RelOp];
                        relLE => DoWith2[self, RelOp];
                        in => DoWith2[self, In];
                        notin => DoWith2[self, In];
                        plus => DoWith2[self, BinaryOp];
                        minus => DoWith2[self, BinaryOp];
                        times => DoWith2[self, BinaryOp];
                        div => DoWith2[self, BinaryOp];
                        mod => DoWith2[self, BinaryOp];
                        power => DoWith2[self, BinaryOp];
                        dot => DoWith2[self, Dot];
                        cdot, dollar, create => Oops[];
                        not => DoWith1[self, Unary];
                        uminus => DoWith1[self, Unary];
                        addr => DoWith1[self, Addr];
                        uparrow => DoWith1[self, Uparrow];
                        min => DoWith1[self, MinMax];
                        max => DoWith1[self, MinMax];
                        lengthen => DoWith1[self, Lengthen];
                        abs => DoWith1[self, Unary];
                        all => DoWith1[self, All];
                        size => DoWith2[self, Size];
                        first => DoWith1[self, FirstLast];
                        last => DoWith1[self, FirstLast];
                        pred => DoWith1[self, Unary];
                        succ => DoWith1[self, Unary];
                        val => DoWith1[self, Ord];
                        ord => DoWith1[self, Ord];
                        arraydesc, length, base => Oops[];
                        loophole => DoWith2[self, Narrow];
                        nil => DoWith1[self, Nil];
                        new => DoWith3[self, New];
                        void => PropagateAttribute[self, $TYPECODE, self, $NEEDTYPECODE];
                        clit => DoWith1[self, CharLit];
                        llit => Oops[];
                        cast => DoWith1[self, Cast];
                        float => DoWith1[self, Float];
                        check, float, pad, chop, safen => Oops[];
                        syscallx => Oops[];
                        narrow => DoWith2[self, Narrow];
                        istype, openx => Oops[];
                        mwconst => DoWith1[self, MWConst];
                        cons => DoWith2[self, Cons];
                        atom => DoWith1[self, Atom];
                        typecode, stringinit, textlit => Oops[];
                        signalinit => NULL;
                        procinit => Oops[];
                        ENDCASE => RETURN [FALSE];
                    };
                {  need: TypeCode = GetTypeCodeAttribute[self, $NEEDTYPECODE];
                    have: TypeCode = GetTypeCodeAttribute[self, $TYPECODE];
                    IF need # nullTypeCode AND have # nullTypeCode THEN {
                        coercions: LIST OF REF Ź Coercions[context: context, from: have, to: need, tree: self];
                        IF coercions # NIL THEN { AddAttribute[self, $COERCIONS, coercions] };
                        };
                    };
                RETURN [TRUE];
                };
        };

    END.