<<>>
    <<IntCodeUtilsImpl.mesa>>
        <<Copyright Ó 1986, 1987, 1989, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) November 30, 1989 8:50:21 pm PST>>
        <<JKF July 27, 1988 8:19:39 am PDT>>
        <<Willie-s, September 23, 1991 6:07 pm PDT>>

    DIRECTORY
        Basics USING [LongNumber],
        Basics16 USING [BITXOR],
        IntCodeDefs USING [ApplyNode, ArithOper, AssignNode, BlockNode, BooleanOper, CaseList, CedarOper, CheckOper, CodeOper, CommentNode, 
        CompareOper, CompositeLocation, CondNode, ConstNode, ConvertOper, DeclNode, DerefLocation, DummyLocation, EnableNode, 
        EscapeLocation, EscapeOper, FieldLocation, GlobalVarLocation, GotoNode, IndexedLocation, Label, LabelNode, LambdaNode, 
        LocalVarLocation, Location, MachineCodeNode, MesaOper, ModuleNode, Node, NodeList, NodeListRep, NodeRep, nullVariableId, 
        Oper, OperNode, OperRep, ReturnNode, SourceNode, UpLevelLocation, Var, VarList, VarListRep, WordConstNode, zerosWord],
        IntCodeUtils USING [Id, IdTab, IdTabRep, IdTabVisitor, LabelVisitor, NullValue, SimplicityLevel, Value, Visitor],
        Rope USING [Equal],
        SafeStorage USING [GetSystemZone];
IntCodeUtilsImpl: CEDAR PROGRAM
    IMPORTS Basics16, Rope, SafeStorage
    EXPORTS IntCodeUtils
    = BEGIN OPEN IntCodeDefs, IntCodeUtils;

<<The zone>>
    zone: PUBLIC ZONE Ź SafeStorage.GetSystemZone[];
        <<The zone for all allocations in the intermediate code phase.  In the non-Cedar world this becomes an UNCOUNTED ZONE.>>

    <<Node walking routines>>

        MapNode: PUBLIC PROC [node: Node, visitor: IntCodeUtils.Visitor] = {
            <<Note: this routine is used so much that it seems best to have MapNodeList and MapLocation expanded specially here.>>
            list: NodeList Ź NIL;
            IF node = NIL THEN GO TO noMore;
            WITH node SELECT FROM
                var: Var => {
                    IF var.location # NIL THEN
                        WITH var.location SELECT FROM
                            deref: DerefLocation =>
                                IF deref.addr # NIL THEN deref.addr Ź visitor[deref.addr];
                            indexed: IndexedLocation => {
                                IF indexed.base # NIL THEN indexed.base Ź visitor[indexed.base];
                                IF indexed.index # NIL THEN indexed.index Ź visitor[indexed.index];
                                };
                            field: FieldLocation =>
                                IF field.base # NIL THEN field.base Ź visitor[field.base];
                            composite: CompositeLocation => {
                                list Ź composite.parts;
                                GO TO continue;
                                };
                            escape: EscapeLocation =>
                                IF escape.base # NIL THEN escape.base Ź visitor[escape.base];
                            ENDCASE;
                    GO TO noMore;
                    EXITS continue => {};
                    };
                block: BlockNode => {
                    list Ź block.nodes;
                    };
                enable: EnableNode => {
                    IF enable.handle # NIL THEN {
                        IF enable.handle.context # NIL THEN
                            enable.handle.context Ź visitor[enable.handle.context];
                        IF enable.handle.proc # NIL THEN
                            enable.handle.proc Ź visitor[enable.handle.proc];
                        };
                    list Ź enable.scope;
                    };
                decl: DeclNode => {
                    IF decl.var # NIL THEN decl.var Ź NARROW[visitor[decl.var]];
                    IF decl.init # NIL THEN decl.init Ź visitor[decl.init];
                    GO TO noMore;
                    };
                assign: AssignNode => {
                    IF assign.lhs # NIL THEN assign.lhs Ź NARROW[visitor[assign.lhs]];
                    IF assign.rhs # NIL THEN assign.rhs Ź visitor[assign.rhs];
                    GO TO noMore;
                    };
                cond: CondNode => {
                    FOR each: CaseList Ź cond.cases, each.rest WHILE each # NIL DO
                        FOR test: NodeList Ź each.tests, test.rest WHILE test # NIL DO
                            IF test.first # NIL THEN test.first Ź visitor[test.first];
                            ENDLOOP;
                        IF each.body # NIL THEN each.body Ź visitor[each.body];
                        ENDLOOP;
                    GO TO noMore;
                    };
                label: LabelNode => {
                    lab: Label Ź label.label;
                    IF lab # NIL AND lab.node # NIL THEN lab.node Ź visitor[lab.node];
                    GO TO noMore;
                    };
                apply: ApplyNode => {
                    IF apply.handler # NIL THEN {
                        IF apply.handler.context # NIL THEN
                            apply.handler.context Ź visitor[apply.handler.context];
                        IF apply.handler.proc # NIL THEN
                            apply.handler.proc Ź visitor[apply.handler.proc];
                        };
                    IF apply.proc # NIL THEN apply.proc Ź visitor[apply.proc];
                    list Ź apply.args;
                    };
                lambda: LambdaNode => {
                    IF lambda.formalArgs # NIL THEN MapVarList[lambda.formalArgs, visitor];
                    list Ź lambda.body;
                    };
                return: ReturnNode => {
                    list Ź return.rets;
                    };
                module: ModuleNode => {
                    MapVarList[module.vars, visitor];
                    list Ź module.procs;
                    };
                source: SourceNode => {
                    list Ź source.nodes;
                    };
                ENDCASE => GO TO noMore;
            WHILE list # NIL DO
                first: Node Ź list.first;
                IF first # NIL THEN list.first Ź visitor[first];
                list Ź list.rest;
                ENDLOOP;
            EXITS noMore => {};
            };

        MapNodeList: PUBLIC PROC [nodeList: NodeList, visitor: Visitor] = {
            <<Note: if you change this, also change MapNode.>>
            FOR each: NodeList Ź nodeList, each.rest WHILE each # NIL DO
                first: Node Ź each.first;
                IF first # NIL THEN each.first Ź visitor[first];
                ENDLOOP;
            };

        MapVarList: PUBLIC PROC [varList: VarList, visitor: Visitor] = {
            FOR each: VarList Ź varList, each.rest WHILE each # NIL DO
                IF each.first # NIL THEN each.first Ź NARROW[visitor[each.first]];
                ENDLOOP;
            };

        MapLocation: PUBLIC PROC [location: Location, visitor: Visitor] = {
            <<Note: if you change this, also change MapNode.>>
            IF location # NIL THEN WITH location SELECT FROM
                deref: DerefLocation => {
                    IF deref.addr # NIL THEN deref.addr Ź visitor[deref.addr];
                    };
                indexed: IndexedLocation => {
                    IF indexed.base # NIL THEN indexed.base Ź visitor[indexed.base];
                    IF indexed.index # NIL THEN indexed.index Ź visitor[indexed.index];
                    };
                field: FieldLocation => {
                    IF field.base # NIL THEN field.base Ź visitor[field.base];
                    };
                composite: CompositeLocation => {
                    MapNodeList[composite.parts, visitor];
                    };
                escape: EscapeLocation => {
                    IF escape.base # NIL THEN escape.base Ź visitor[escape.base];
                    };
                ENDCASE;
            };

        VisitLabels: PUBLIC PROC
        [node: Node, visitor: LabelVisitor, fullTree: BOOL, visitNIL: BOOL Ź FALSE] = {
            inner: IntCodeUtils.Visitor = {
                <<[node: IntCodeDefs.Node] RETURNS [IntCodeDefs.Node]>>
                WITH node SELECT FROM
                    var: Var =>
                        WITH var.location SELECT FROM
                            localVar: LocalVarLocation =>
                                IF visitNIL OR localVar.parent # NIL THEN
                                    localVar.parent Ź visitor[localVar.parent, node, FALSE];
                            ENDCASE;
                    label: LabelNode =>
                        IF visitNIL OR label.label # NIL THEN
                            label.label Ź visitor[label.label, node, TRUE];
                    goto: GotoNode =>
                        IF visitNIL OR goto.dest # NIL THEN
                            goto.dest Ź visitor[goto.dest, node, FALSE];
                    lambda: LambdaNode =>
                        IF visitNIL OR lambda.parent # NIL THEN
                            lambda.parent Ź visitor[lambda.parent, node, FALSE];
                    oper: OperNode =>
                        WITH oper.oper SELECT FROM
                            code: REF code OperRep =>
                                IF visitNIL OR code.label # NIL THEN
                                    code.label Ź visitor[code.label, node, FALSE];
                            ENDCASE;
                    ENDCASE;
                IF fullTree THEN MapNode[node, inner];
                RETURN [node];
                };
            [] Ź inner[node];
            };

<<Node & var list routines>>
    NodeListCons: PUBLIC PROC [first: Node, rest: NodeList Ź NIL] RETURNS [NodeList] = {
        RETURN [zone.NEW[NodeListRep Ź [first, rest]]];
        };

    NodeListTail: PUBLIC PROC [list: NodeList] RETURNS [NodeList] = {
        IF list = NIL THEN RETURN [NIL];
        DO
            rest: NodeList Ź list.rest;
            IF rest = NIL THEN RETURN [list];
            list Ź rest;
            ENDLOOP;
        };

    VarListCons: PUBLIC PROC [first: Var, rest: VarList Ź NIL] RETURNS [VarList] = {
        RETURN [zone.NEW[VarListRep Ź [first, rest]]];
        };

    VarListTail: PUBLIC PROC [list: VarList] RETURNS [VarList] = {
        IF list = NIL THEN RETURN [NIL];
        DO
            rest: VarList Ź list.rest;
            IF rest = NIL THEN RETURN [list];
            list Ź rest;
            ENDLOOP;
        };

    <<>>
<<Equality & side effect routines>>
    SideEffectFree: PUBLIC PROC [node: Node, noSignals: BOOL] RETURNS [BOOL] = {
        <<Returns TRUE if the evaluation of node is guaranteed to not have side effects.>>
        <<IF noSignals THEN raising a signal (or any other control flow change) is considered to be a side effect.  If NOT noSignals, then 
        a side-effect is not considered to take place if normal control is interrupted for a check.>>
        DO
            WITH node SELECT FROM
                var: Var => WITH var.location SELECT FROM
                    g: GlobalVarLocation => RETURN [TRUE];
                    l: LocalVarLocation => RETURN [TRUE];
                    f: FieldLocation => {node Ź f.base; LOOP};
                    c: CompositeLocation => RETURN [SideEffectFreeList[c.parts, noSignals]];
                    u: UpLevelLocation => RETURN [TRUE];
                    d: DerefLocation =>
                        IF noSignals THEN RETURN [FALSE] ELSE {node Ź d.addr; LOOP};
                            <<note: an address fault can turn into a signal>>
                    d: DummyLocation => RETURN [TRUE];
                    x: IndexedLocation =>
                        IF SideEffectFree[x.index, noSignals] THEN {node Ź x.base; LOOP};
                    ENDCASE;
                const: ConstNode => RETURN [TRUE];
                comment: CommentNode => RETURN [TRUE];
                oper: OperNode => RETURN [TRUE];
                apply: ApplyNode => {
                    args: NodeList = apply.args;
                    IF apply.handler # NIL THEN RETURN [FALSE];
                    IF NOT SideEffectFreeList[args, noSignals] THEN RETURN [FALSE];
                    WITH apply.proc SELECT FROM
                        oper: OperNode =>
                            WITH oper.oper SELECT FROM
                                arith: ArithOper => 
                                    SELECT TRUE FROM
                                        NOT noSignals => RETURN [TRUE];
                                        arith.class.kind >= real => RETURN [FALSE];
                                        arith.class.checked => RETURN [FALSE];
                                        ENDCASE => SELECT arith.select FROM
                                            div, mod => {
                                                IF args # NIL AND args.rest # NIL THEN
                                                    WITH args.rest.first SELECT FROM
                                                        wc: WordConstNode =>
                                                            IF wc.word # IntCodeDefs.zerosWord THEN
                                                                RETURN [TRUE];
                                                        ENDCASE;
                                                RETURN [FALSE];
                                                    <<The divisor could be zero>>
                                                };
                                            ENDCASE => RETURN [TRUE];
                                boolean: BooleanOper => RETURN [TRUE];
                                convert: ConvertOper => 
                                    SELECT TRUE FROM
                                        NOT noSignals => RETURN [TRUE];
                                        convert.from.kind # convert.to.kind => RETURN [FALSE];
                                        convert.from.kind >= real => RETURN [FALSE];
                                        convert.from.precision > convert.to.precision => RETURN [FALSE];
                                        ENDCASE => RETURN [TRUE];
                                check: CheckOper => RETURN [NOT noSignals];
                                compare: CompareOper =>
                                    SELECT TRUE FROM
                                        NOT noSignals => RETURN [TRUE];
                                        compare.class.kind >= real => RETURN [FALSE];
                                        ENDCASE => RETURN [TRUE];
                                mesa: MesaOper => SELECT mesa.mesa FROM
                                    addr, all, equal, notEqual => RETURN [TRUE];
                                    ENDCASE;
                                cedar: CedarOper => SELECT cedar.cedar FROM
                                    narrow, referentType, procCheck => RETURN [NOT noSignals];
                                    ENDCASE;
                                ENDCASE;
                        ENDCASE;
                    };
                block: BlockNode => RETURN [SideEffectFreeList[block.nodes, noSignals]];
                decl: DeclNode => {node Ź decl.init; LOOP};
                label: LabelNode => {node Ź label.label.node; LOOP};
                goto: GotoNode => RETURN [NOT noSignals];
                mc: REF NodeRep.machineCode => RETURN [TRUE];
                source: SourceNode => RETURN [SideEffectFreeList[source.nodes, noSignals]];
                cond: CondNode => {
                    FOR each: CaseList Ź cond.cases, each.rest WHILE each # NIL DO
                        IF NOT SideEffectFreeList[each.tests, noSignals] THEN RETURN [FALSE];
                        IF NOT SideEffectFree[each.body, noSignals] THEN RETURN [FALSE];
                        ENDLOOP;
                    RETURN [TRUE];
                    };
                ENDCASE => IF node = NIL THEN RETURN [TRUE];
            RETURN [FALSE];
            ENDLOOP;
        };

    SideEffectFreeList: PUBLIC PROC [nodes: NodeList, noSignals: BOOL] RETURNS [BOOL] = {
        <<Returns TRUE if the evaluation of node is guaranteed to not have side effects (noSignals => raising a signal has side effects).>>
        FOR each: NodeList Ź nodes, each.rest WHILE each # NIL DO
            IF NOT SideEffectFree[each.first, noSignals] THEN RETURN [FALSE];
            ENDLOOP;
        RETURN [TRUE];
        };

    SimplyEqual: PUBLIC PROC [n1, n2: Node] RETURNS [BOOL] = {
        DO
            IF n1 = n2 THEN RETURN [TRUE];
            IF n1 = NIL OR n2 = NIL THEN RETURN [FALSE];
            IF n1.bits # n2.bits THEN RETURN [FALSE];
            WITH n1 SELECT FROM
                const1: WordConstNode => WITH n2 SELECT FROM
                    const2: WordConstNode => RETURN [const1.word = const2.word];
                    ENDCASE;
                var1: Var => WITH n2 SELECT FROM
                    var2: Var => {
                        loc1: Location Ź var1.location;
                        loc2: Location Ź var2.location;
                        IF loc1 = loc2 THEN RETURN [TRUE];
                        IF loc1 = NIL OR loc2 = NIL THEN RETURN [FALSE];
                        IF var1.id # nullVariableId AND var1.id = var2.id THEN RETURN [TRUE];
                        WITH loc1 SELECT FROM
                            deref1: DerefLocation =>
                                WITH loc2 SELECT FROM
                                    deref2: DerefLocation =>
                                        IF deref1.align = deref2.align THEN {
                                            n1 Ź deref1.addr;
                                            n2 Ź deref2.addr;
                                            LOOP;
                                            };
                                    ENDCASE;
                            field1: FieldLocation =>
                                WITH loc2 SELECT FROM
                                    field2: FieldLocation =>
                                        IF field1.start = field2.start THEN {
                                            n1 Ź field1.base;
                                            n2 Ź field2.base;
                                            LOOP;
                                            };
                                    ENDCASE;
                            index1: IndexedLocation =>
                                WITH loc2 SELECT FROM
                                    index2: IndexedLocation =>
                                        IF SimplyEqual[index1.base, index2.base] THEN {
                                            n1 Ź index1.index;
                                            n2 Ź index2.index;
                                            LOOP;
                                            };
                                    ENDCASE;
                            dummy1: DummyLocation =>
                                WITH loc2 SELECT FROM
                                    index2: DummyLocation => RETURN [TRUE];
                                    ENDCASE;
                            ENDCASE;
                        };
                    ENDCASE;
                source1: SourceNode => WITH n2 SELECT FROM
                    source2: SourceNode => RETURN [SimplyEqualList[source1.nodes, source2.nodes]];
                    ENDCASE;
                block1: BlockNode => WITH n2 SELECT FROM
                    block2: BlockNode => RETURN [SimplyEqualList[block1.nodes, block2.nodes]];
                    ENDCASE;
                apply1: ApplyNode => WITH n2 SELECT FROM
                    apply2: ApplyNode => {
                        IF apply1.handler # NIL OR apply2.handler # NIL THEN RETURN [FALSE];
                        IF NOT SimplyEqualList[apply1.args, apply2.args] THEN RETURN [FALSE];
                        n1 Ź apply1.proc;
                        n2 Ź apply2.proc;
                        LOOP;
                        };
                    ENDCASE;
                assign1: AssignNode => WITH n2 SELECT FROM
                    assign2: AssignNode => {
                        IF NOT SimplyEqual[assign1.lhs, assign2.lhs] THEN RETURN [FALSE];
                        n1 Ź assign1.rhs;
                        n2 Ź assign2.rhs;
                        LOOP;
                        };
                    ENDCASE;
                label1: LabelNode => WITH n2 SELECT FROM
                    label2: LabelNode => {
                        IF LabelEqual[label1.label, label2.label] THEN {
                            n1 Ź label1.label.node;
                            n2 Ź label2.label.node;
                            LOOP;
                            };
                        };
                    ENDCASE;
                goto1: GotoNode => WITH n2 SELECT FROM
                    goto2: GotoNode => RETURN [LabelEqual[goto1.dest, goto2.dest]];
                    ENDCASE;
                rtn1: ReturnNode => WITH n2 SELECT FROM
                    rtn2: ReturnNode => RETURN [SimplyEqualList[rtn1.rets, rtn2.rets]];
                    ENDCASE;
                oper1: OperNode => WITH n2 SELECT FROM
                    oper2: OperNode => RETURN [OperEqual[oper1.oper, oper2.oper]];
                    ENDCASE;
                mc1: MachineCodeNode => WITH n2 SELECT FROM
                    mc2: MachineCodeNode => RETURN [Rope.Equal[mc1.bytes, mc2.bytes]];
                    ENDCASE;
                cmt1: CommentNode => WITH n2 SELECT FROM
                    cmt2: CommentNode => RETURN [TRUE];
                        <<All comments are considered equal>>
                    ENDCASE;
                ENDCASE;
            RETURN [FALSE];
            ENDLOOP;
        };

        LabelEqual: PROC [lab1: Label, lab2: Label] RETURNS [BOOL] = {
            IF lab1 = lab2 THEN RETURN [TRUE];
            IF lab1 = NIL OR lab2 = NIL THEN RETURN [FALSE];
            RETURN [lab1.id = lab2.id];
            };

        OperEqual: PROC [op1: Oper, op2: Oper] RETURNS [BOOL] = {
            IF op1 = op2 THEN RETURN [TRUE];
            IF op1 = NIL OR op2 = NIL THEN RETURN [FALSE];
            WITH op1 SELECT FROM
                code1: CodeOper => WITH op2 SELECT FROM
                    code2: CodeOper => RETURN [code1.direct = code2.direct
                    AND code1.offset = code2.offset
                    AND LabelEqual[code1.label, code2.label]];
                    ENDCASE;
                arith1: ArithOper => WITH op2 SELECT FROM
                    arith2: ArithOper => RETURN [arith1.class = arith2.class
                    AND arith1.select = arith2.select];
                    ENDCASE;
                bool1: BooleanOper => WITH op2 SELECT FROM
                    bool2: BooleanOper => RETURN [bool1.class = bool2.class
                    AND bool1.bits = bool2.bits];
                    ENDCASE;
                cvt1: ConvertOper => WITH op2 SELECT FROM
                    cvt2: ConvertOper => RETURN [cvt1.to = cvt2.to
                    AND cvt1.from = cvt2.from];
                    ENDCASE;
                chk1: CheckOper => WITH op2 SELECT FROM
                    chk2: CheckOper => RETURN [chk1.class = chk2.class
                    AND chk1.sense = chk2.sense];
                    ENDCASE;
                cmp1: CompareOper => WITH op2 SELECT FROM
                    cmp2: CompareOper => RETURN [cmp1.class = cmp2.class
                    AND cmp1.sense = cmp2.sense];
                    ENDCASE;
                mesa1: MesaOper => WITH op2 SELECT FROM
                    mesa2: MesaOper => RETURN [mesa1.mesa = mesa2.mesa
                    AND mesa1.info = mesa2.info];
                    ENDCASE;
                cedar1: CedarOper => WITH op2 SELECT FROM
                    cedar2: CedarOper => RETURN [cedar1.cedar = cedar2.cedar
                    AND cedar1.info = cedar2.info];
                    ENDCASE;
                escape1: EscapeOper => WITH op2 SELECT FROM
                    escape2: EscapeOper => RETURN [escape1.escape = escape2.escape
                    AND escape1.info = escape2.info];
                    ENDCASE;
                ENDCASE;
            RETURN [FALSE];
            };

    SimplyEqualList: PUBLIC PROC [nl1, nl2: NodeList] RETURNS [BOOL] = {
        DO
            SELECT TRUE FROM
                nl1 = nl2 => RETURN [TRUE];
                nl1 = NIL, nl2 = NIL => RETURN [FALSE];
                ENDCASE => {
                    n1: Node Ź nl1.first;
                    n2: Node Ź nl2.first;
                    WITH nl1.first SELECT FROM
                        comment: CommentNode => GO TO spin1;
                        source: SourceNode => SELECT TRUE FROM
                            source.nodes = NIL => GO TO spin1;
                            source.nodes.rest = NIL => n1 Ź source.nodes.first;
                            ENDCASE;
                        ENDCASE;
                    WITH nl2.first SELECT FROM
                        comment: CommentNode => GO TO spin2;
                        source: SourceNode => SELECT TRUE FROM
                            source.nodes = NIL => GO TO spin2;
                            source.nodes.rest = NIL => n2 Ź source.nodes.first;
                            ENDCASE;
                        ENDCASE;
                    IF NOT SimplyEqual[n1, n2] THEN RETURN [FALSE];
                    nl1 Ź nl1.rest;
                    nl2 Ź nl2.rest;
                    EXITS
                        spin1 => nl1 Ź nl1.rest;
                        spin2 => nl2 Ź nl2.rest;
                    };
            ENDLOOP;
        };

    IsSimple: PUBLIC PROC [node: Node, level: SimplicityLevel] RETURNS [BOOL] = {
        <<Returns TRUE if the evaluation of node is guaranteed to not have side effects.>>
        <<IF noSignals THEN raising a signal is considered to be a side effect.>>
        inner: PROC [node: Node] RETURNS [BOOL] = {
            list: NodeList Ź NIL;
            IF node = NIL THEN GO TO retTrue;
            IF level.maxBits # 0 AND node.bits > level.maxBits THEN GO TO retFalse;
            DO
                WITH node SELECT FROM
                    var: Var => WITH var.location SELECT FROM
                        g: GlobalVarLocation => GO TO retTrue;
                        l: LocalVarLocation => GO TO retTrue;
                        f: FieldLocation => {node Ź f.base; LOOP};
                        c: CompositeLocation => {list Ź c.parts; EXIT};
                        u: UpLevelLocation => RETURN [level.derefs # 0];
                        d: DerefLocation =>
                            IF level.derefs # 0 THEN {
                                level.derefs Ź level.derefs - 1;
                                node Ź d.addr;
                                LOOP;
                                };
                        d: DummyLocation => GO TO retTrue;
                        x: IndexedLocation => {
                            IF level.simpleOps # 0 THEN {
                                level.simpleOps Ź level.simpleOps - 1;
                                IF inner[x.index] THEN {node Ź x.base; LOOP};
                                };
                            };
                        ENDCASE;
                    const: ConstNode => GO TO retTrue;
                    comment: CommentNode => GO TO retTrue;
                    apply: ApplyNode => {
                        IF apply.handler # NIL THEN GO TO retFalse;
                        IF level.simpleOps = 0 THEN GO TO retFalse;
                        level.simpleOps Ź level.simpleOps - 1;
                        FOR each: NodeList Ź apply.args, each.rest WHILE each # NIL DO
                            IF NOT inner[each.first] THEN GO TO retFalse;
                            ENDLOOP;
                        WITH apply.proc SELECT FROM
                            oper: OperNode =>
                                WITH oper.oper SELECT FROM
                                    arith: ArithOper => RETURN [level.noSignals];
                                    boolean: BooleanOper => GO TO retTrue;
                                    convert: ConvertOper => RETURN [level.noSignals];
                                    check: CheckOper => RETURN [level.noSignals];
                                    compare: CompareOper => GO TO retTrue;
                                    mesa: MesaOper => SELECT mesa.mesa FROM
                                        addr, all, equal, notEqual => GO TO retTrue;
                                        ENDCASE;
                                    cedar: CedarOper => SELECT cedar.cedar FROM
                                        narrow, referentType, procCheck => RETURN [level.noSignals];
                                        ENDCASE;
                                    ENDCASE;
                            ENDCASE;
                        };
                    block: BlockNode => {list Ź block.nodes; EXIT};
                    source: SourceNode => {list Ź source.nodes; EXIT};
                    cond: CondNode => {
                        FOR each: CaseList Ź cond.cases, each.rest WHILE each # NIL DO
                            FOR test: NodeList Ź each.tests, test.rest WHILE test # NIL DO
                                IF NOT inner[test.first] THEN GO TO retFalse;
                                ENDLOOP;
                            IF NOT inner[each.body] THEN GO TO retFalse;
                            ENDLOOP;
                        GO TO retTrue;
                        };
                    ENDCASE => IF node = NIL THEN GO TO retTrue;
                GO TO retFalse;
                ENDLOOP;
            FOR each: NodeList Ź list, each.rest WHILE each # NIL DO
                IF NOT inner[each.first] THEN GO TO retFalse;
                ENDLOOP;
            GO TO retTrue;
            EXITS
                retFalse => RETURN [FALSE];
                retTrue => RETURN [TRUE];
            };
        RETURN [inner[node]];
        };

    IsSimpleList: PUBLIC PROC [list: NodeList, level: SimplicityLevel] RETURNS [BOOL] = {
        FOR each: NodeList Ź list, each.rest WHILE each # NIL DO
            IF NOT IsSimple[each.first, level] THEN RETURN [FALSE];
            ENDLOOP;
        RETURN [TRUE];
        };
<<IDTab types & routines>>
    <<IdTab: TYPE = REF IdTabRep;>>
    <<IdTabRep: TYPE = RECORD [>>
        <<entries: Id _ 0,>>
        <<data: REF _ NIL>>
        <<];>>
        <<>>
    <<Id: TYPE = INT;>>

    IdTabArray: TYPE = REF IdTabArrayRep;
    IdTabArrayRep: TYPE = ARRAY IdTabIndex OF IdTabEntry;

    IdTabIndex: TYPE = [0..IdTabIndexMod);
        IdTabIndexMod: NAT = 256;

    IdTabEntry: TYPE = REF IdTabEntryRep;
    IdTabEntryRep: TYPE = RECORD [
        next: IdTabEntry Ź NIL,
        key: Id Ź 0,
        value: Value Ź NullValue];

    smallTabLimit: NAT Ź 4;

    IdHash: PROC [id: Id] RETURNS [IdTabIndex] = INLINE {
        ln: Basics.LongNumber Ź [int[id]];
        RETURN [Basics16.BITXOR[Basics16.BITXOR[ln.lh, ln.ll], Basics16.BITXOR[ln.hh, ln.hl]] MOD IdTabIndexMod];
        };
        <<>>
    NewIdTab: PUBLIC PROC RETURNS [IdTab] = {
        <<Returns a new id tab with no elements.>>
        RETURN [zone.NEW[IdTabRep Ź [0, NIL]]];
        };

    Fetch: PUBLIC PROC [idTab: IdTab, id: Id] RETURNS [Value Ź NullValue] = {
        <<Fetches the value associated with the given id in the given table.  Returns NullValue if there was no value.>>
        chain: IdTabEntry Ź NIL;
        WITH idTab.data SELECT FROM
            array: IdTabArray => chain Ź array[IdHash[id]];
            entry: IdTabEntry => chain Ź entry;
            ENDCASE => RETURN [NIL];
        FOR each: IdTabEntry Ź chain, each.next WHILE each # NIL DO
            IF id = each.key THEN RETURN [each.value];
            ENDLOOP;
        };

    Store: PUBLIC PROC [idTab: IdTab, id: Id, val: REF Ź NIL] RETURNS [old: Value Ź NullValue] = {
        <<Stores a new value for the given id.  Returns the old value (or NullValue if none).  Storing NullValue is equivalent to deleting 
        the old value.>>
        WITH idTab.data SELECT FROM
            array: IdTabArray => {
                hash: IdTabIndex Ź IdHash[id];
                start: IdTabEntry Ź array[hash];
                FOR each: IdTabEntry Ź start, each.next WHILE each # NIL DO
                    IF id = each.key THEN {
                        old Ź each.value;
                        each.value Ź val;
                        SELECT TRUE FROM
                            old = val => {};
                            old = NIL => idTab.entries Ź idTab.entries + 1;
                            val = NIL => idTab.entries Ź idTab.entries - 1;
                            ENDCASE;
                        RETURN};
                    ENDLOOP;
                array[hash] Ź zone.NEW[IdTabEntryRep Ź [next: start, key: id, value: val]];
                idTab.entries Ź idTab.entries + 1;
                RETURN;
                };
            start: IdTabEntry => {
                FOR each: IdTabEntry Ź start, each.next WHILE each # NIL DO
                    IF id = each.key THEN {
                        old Ź each.value;
                        each.value Ź val;
                        SELECT TRUE FROM
                            old = val => {};
                            old = NIL => idTab.entries Ź idTab.entries + 1;
                            val = NIL => idTab.entries Ź idTab.entries - 1;
                            ENDCASE;
                        RETURN};
                    ENDLOOP;
                idTab.data Ź zone.NEW[IdTabEntryRep Ź [next: start, key: id, value: val]];
                };
            ENDCASE =>
                idTab.data Ź zone.NEW[IdTabEntryRep Ź [next: NIL, key: id, value: val]];
        IF (idTab.entries Ź idTab.entries + 1) > smallTabLimit THEN MakeBigTab[idTab];
        };

    Insert: PUBLIC PROC [idTab: IdTab, id: Id, val: REF] RETURNS [old: REF Ź NIL] = {
        <<Stores a new value for the given id only if there was no previous value.  Returns the old value (or NullValue if none).  
        Inserting NullValue is a null operation.>>
        WITH idTab.data SELECT FROM
            array: IdTabArray => {
                hash: IdTabIndex Ź IdHash[id];
                start: IdTabEntry Ź array[hash];
                FOR each: IdTabEntry Ź start, each.next WHILE each # NIL DO
                    IF id = each.key THEN {
                        old Ź each.value;
                        IF old = NIL THEN each.value Ź val;
                        SELECT TRUE FROM
                            old = val => {};
                            old = NIL => idTab.entries Ź idTab.entries + 1;
                            val = NIL => idTab.entries Ź idTab.entries - 1;
                            ENDCASE;
                        RETURN};
                    ENDLOOP;
                array[hash] Ź zone.NEW[IdTabEntryRep Ź [next: start, key: id, value: val]];
                idTab.entries Ź idTab.entries + 1;
                RETURN;
                };
            start: IdTabEntry => {
                FOR each: IdTabEntry Ź start, each.next WHILE each # NIL DO
                    IF id = each.key THEN {
                        old Ź each.value;
                        IF old = NIL THEN each.value Ź val;
                        SELECT TRUE FROM
                            old = val => {};
                            old = NIL => idTab.entries Ź idTab.entries + 1;
                            val = NIL => idTab.entries Ź idTab.entries - 1;
                            ENDCASE;
                        RETURN};
                    ENDLOOP;
                idTab.data Ź zone.NEW[IdTabEntryRep Ź [next: start, key: id, value: val]];
                };
            ENDCASE =>
                idTab.data Ź zone.NEW[IdTabEntryRep Ź [next: NIL, key: id, value: val]];
        IF (idTab.entries Ź idTab.entries + 1) > smallTabLimit THEN MakeBigTab[idTab];
        };

    Enumerate: PUBLIC PROC [idTab: IdTab, visitor: IdTabVisitor] = {
        <<Applies the visitor to each association in the table.>>
        WITH idTab.data SELECT FROM
            array: IdTabArray =>
                FOR ax: IdTabIndex IN IdTabIndex DO
                    FOR each: IdTabEntry Ź array[ax], each.next WHILE each # NIL DO
                        val: Value Ź each.value;
                        IF val # NullValue AND visitor[each.key, val] THEN RETURN;
                        ENDLOOP;
                    ENDLOOP;
            entry: IdTabEntry =>
                FOR each: IdTabEntry Ź entry, each.next WHILE each # NIL DO
                    val: Value Ź each.value;
                    IF val # NullValue AND visitor[each.key, val] THEN RETURN;
                    ENDLOOP;
            ENDCASE;
        };

    MakeBigTab: PROC [idTab: IdTab] = {
        <<Convert a small table into a big table.  We require that the table have been small, of course.>>
        chain: IdTabEntry Ź NARROW[idTab.data];
        array: IdTabArray Ź zone.NEW[IdTabArrayRep Ź ALL[NIL]];
        WHILE chain # NIL DO
            next: IdTabEntry Ź chain.next;
            hash: IdTabIndex Ź IdHash[chain.key];
            chain.next Ź array[hash];
            array[hash] Ź chain;
            chain Ź next;
            ENDLOOP;
        idTab.data Ź array;
        };

    END.