
    <<TreePack.Mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 12:19:19 pm PDT>>
        <<Paul Rovner, September 7, 1983 12:12 am>>
        <<Russ Atkinson (RRA) March 6, 1985 10:26:01 pm PST>>
        <<Sweet June 4, 1986 9:48:04 am PDT>>

    DIRECTORY
        Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
        Literals USING [LTIndex, STIndex],
        Symbols: TYPE USING [HTIndex, ISEIndex],
        Tree: TYPE USING [AttrId, Base, Finger, Id, Info, Index, Link, LinkRep, LinkTag, Map, Node, NodeName, Scan, Test, Null, nullIndex, 
        nullInfo, treeType],
        TreeOps: TYPE USING [GetTag];

    TreePack: PROGRAM
        IMPORTS Alloc, TreeOps EXPORTS TreeOps = {

        initialized: BOOL _ FALSE;

        table: PRIVATE Alloc.Handle;

        LinkSeq: TYPE = RECORD[SEQUENCE length: CARDINAL OF Tree.Link];
        LinkStack: TYPE = REF LinkSeq;

        stack: LinkStack;
        sI: CARDINAL;

        tb: Tree.Base;        -- tree base

        UpdateBase: Alloc.Notifier = {tb _ base[Tree.treeType]};


        Initialize: PUBLIC PROC[ownTable: Alloc.Handle] = {
            IF initialized THEN Finalize[];
            stack _ NEW[LinkSeq[250]];  sI _ 0;
            table _ ownTable;
            table.AddNotify[UpdateBase];
            IF MakeNode[$none,0] # Tree.Null THEN ERROR;    -- reserve null
            initialized _ TRUE};

        Reset: PUBLIC PROC = {
            IF initialized AND stack.length > 250 THEN {
                stack _ NEW[LinkSeq[250]]}};

        Finalize: PUBLIC PROC = {
            table.DropNotify[UpdateBase]; table _ NIL;
            stack _ NIL;
            initialized _ FALSE};


        ExpandStack: PROC = {
            newStack: LinkStack = NEW[LinkSeq[stack.length + 256]];
            FOR i: CARDINAL IN [0 .. stack.length) DO newStack[i] _ stack[i] ENDLOOP;
            stack _ newStack};


        PushTree: PUBLIC PROC[v: Tree.Link] = {
            IF sI >= stack.length THEN ExpandStack[];
            stack[sI] _ v;  sI _ sI+1};

        PopTree: PUBLIC PROC RETURNS[Tree.Link] = {RETURN[stack[sI_sI-1]]};


        InsertTree: PUBLIC PROC[v: Tree.Link, n: CARDINAL] = {
            i: CARDINAL;
            IF sI >= stack.length THEN ExpandStack[];
            i _ sI;  sI _ sI+1;
            THROUGH [1 .. n) DO stack[i] _ stack[i-1]; i _ i-1 ENDLOOP;
            stack[i] _ v};

        ExtractTree: PUBLIC PROC[n: CARDINAL] RETURNS[v: Tree.Link] = {
            i: CARDINAL _ sI - n;
            v _ stack[i];
            THROUGH [1 .. n) DO stack[i] _ stack[i+1]; i _ i+1 ENDLOOP;
            sI _ sI - 1;
            RETURN[v]};


        MakeNode: PUBLIC PROC[name: Tree.NodeName, count: INTEGER] RETURNS[Tree.Link] = {
            PushNode[name, count];  RETURN[PopTree[]]};

        MakeList: PUBLIC PROC[size: INTEGER] RETURNS[Tree.Link] = {
            PushList[size];  RETURN[PopTree[]]};


        PushNode: PUBLIC PROC[name: Tree.NodeName, count: INTEGER] = {
            nSons: CARDINAL = count.ABS;
            node: Tree.Index = table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
            i: CARDINAL;
            tb[node].name _ name;  tb[node].nSons _ nSons;
            tb[node].info _ Tree.nullInfo;  tb[node].shared _ FALSE;
            tb[node].attr1 _ tb[node].attr2 _ tb[node].attr3 _ FALSE;
            IF count >= 0 THEN
                FOR i _ nSons, i-1 WHILE i >= 1 DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP
            ELSE
                FOR i _ 1, i+1 WHILE i <= nSons DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP;
            IF sI >= stack.length THEN ExpandStack[];
            stack[sI] _ [subtree[index: node]];  sI _ sI+1};

        PushList: PUBLIC PROC[size: INTEGER] = {
            nSons: CARDINAL = size.ABS;
            node: Tree.Index;
            i: CARDINAL;
            SELECT nSons FROM
                1 => NULL;
                0 => PushTree[Tree.Null];
                ENDCASE => {
                    node _ table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
                    tb[node].name _ $list;
                    tb[node].info _ Tree.nullInfo;  tb[node].shared _ FALSE;
                    tb[node].attr1 _ tb[node].attr2 _ tb[node].attr3 _ FALSE;
                    tb[node].nSons _ nSons;
                    IF size > 0 THEN
                        FOR i _ nSons, i-1 WHILE i >= 1 DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP
                    ELSE
                        FOR i _ 1, i+1 WHILE i <= nSons DO tb[node].son[i] _ stack[sI_sI-1] ENDLOOP;
                    IF sI >= stack.length THEN ExpandStack[];
                    stack[sI] _ [subtree[index: node]];  sI _ sI+1}
            };

        PushProperList: PUBLIC PROC[size: INTEGER] = {
            IF size IN [-1..1] THEN PushNode[$list, size]
            ELSE PushList[size]};


        PushHash: PUBLIC PROC[hti: Symbols.HTIndex] = {PushTree[[hash[index: hti]]]};

        PushSe: PUBLIC PROC[sei: Symbols.ISEIndex] = {PushTree[[symbol[index: sei]]]};

        PushLit: PUBLIC PROC[lti: Literals.LTIndex] = {PushTree[[literal[index: lti]]]};

        PushString: PUBLIC PROC[sti: Literals.STIndex] = {PushTree[[string[index: sti]]]};

        SetInfo: PUBLIC PROC[info: Tree.Info] = {
            t: Tree.Link = stack[sI-1];
            WITH v: t SELECT TreeOps.GetTag[v] FROM
                subtree => IF v # Tree.Null THEN tb[v.index].info _ info;
                ENDCASE
            };

        SetAttr: PUBLIC PROC[attr: Tree.AttrId, value: BOOL] = {
            t: Tree.Link = stack[sI-1];
            WITH v: t SELECT TreeOps.GetTag[v] FROM
                subtree => IF v = Tree.Null THEN ERROR
                    ELSE
                        SELECT attr FROM
                            1 => tb[v.index].attr1 _ value;
                            2 => tb[v.index].attr2 _ value;
                            3 => tb[v.index].attr3 _ value;
                            ENDCASE;
                ENDCASE => ERROR
            };


        FreeNode: PUBLIC PROC[node: Tree.Index] = {
            IF node # Tree.nullIndex AND ~tb[node].shared THEN {
                i: CARDINAL;
                n: CARDINAL _ tb[node].nSons;
                FOR i IN [1..n] DO
                    t: Tree.Link _ tb[node].son[i];
                    WITH v: t SELECT TreeOps.GetTag[t] FROM
                        subtree => FreeNode[v.index];
                        ENDCASE;
                    ENDLOOP;
                table.FreeChunk[node, Tree.Node.SIZE+n*Tree.Link.SIZE, Tree.treeType]}
            };

        FreeTree: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
            WITH t SELECT TreeOps.GetTag[t] FROM subtree => FreeNode[index] ENDCASE;
            RETURN[Tree.Null]};


    <<procedures for tree testing>>
        <<>>
        IsTree: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE {
            RETURN[LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.subtree.ORD]};

        Narrow: PROC[t: Tree.Link] RETURNS[Tree.Index] = INLINE {
            RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.subtree.ORD THEN LOOPHOLE[t] ELSE ERROR]};

        GetHash: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.HTIndex] = {
            RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.hash.ORD THEN LOOPHOLE[t] ELSE ERROR]};

        GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Index] = {RETURN[Narrow[t]]};

        GetSe: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.ISEIndex] = {
            RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.symbol.ORD THEN LOOPHOLE[t] ELSE ERROR]};

        GetLit: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.LTIndex] = {
            RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.literal.ORD THEN LOOPHOLE[t] ELSE ERROR]};

        GetStr: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.STIndex] = {
            RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.string.ORD THEN LOOPHOLE[t] ELSE ERROR]};

        NthSon: PUBLIC PROC[t: Tree.Link, n: CARDINAL] RETURNS[Tree.Link] = {
            RETURN[IF t = Tree.Null
                THEN ERROR
                ELSE WITH t SELECT TreeOps.GetTag[t] FROM 
                    subtree => tb[index].son[n],
                    ENDCASE => ERROR]
            };

        OpName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.NodeName] = {
            RETURN[IF t = Tree.Null
                THEN $none
                ELSE WITH t SELECT TreeOps.GetTag[t] FROM subtree => tb[index].name ENDCASE => $none]
            };

        GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] = {
            node: Tree.Index = Narrow[t];
            RETURN[IF t = Tree.Null
                THEN ERROR
                ELSE SELECT attr FROM
                    1 => tb[node].attr1,
                    2 => tb[node].attr2,
                    3 => tb[node].attr3,
                    ENDCASE => ERROR]
            };

        PutAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId, value: BOOL] = {
            node: Tree.Index = Narrow[t];
            IF t = Tree.Null THEN ERROR;
            SELECT attr FROM
                1 => tb[node].attr1 _ value;
                2 => tb[node].attr2 _ value;
                3 => tb[node].attr3 _ value;
                ENDCASE => ERROR
            };

        GetInfo: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Info] = {
            RETURN[IF t # Tree.Null
                THEN tb[Narrow[t]].info    
                ELSE ERROR]
            };

        PutInfo: PUBLIC PROC[t: Tree.Link, value: Tree.Info] = {
            IF t = Tree.Null THEN ERROR;
            tb[Narrow[t]].info _ value};

        Shared: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            RETURN[WITH s: t SELECT TreeOps.GetTag[t] FROM
                subtree => IF s = Tree.Null THEN FALSE ELSE tb[s.index].shared,
                ENDCASE => FALSE]
            };

        MarkShared: PUBLIC PROC[t: Tree.Link, shared: BOOL] = {
            WITH s: t SELECT TreeOps.GetTag[t] FROM
                subtree => IF s # Tree.Null THEN tb[s.index].shared _ shared;
                ENDCASE
            };

        SonCount: PROC[node: Tree.Index] RETURNS[CARDINAL] = INLINE {
            RETURN[SELECT node FROM
                Tree.nullIndex => 0,
                ENDCASE => tb[node].nSons]
            };


    <<procedures for tree traversal>>

        ScanSons: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
            IF root # Tree.Null THEN
                WITH root SELECT TreeOps.GetTag[root] FROM
                    subtree => {
                        node: Tree.Index = index;
                        FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
                            action[tb[node].son[i]] ENDLOOP};
                    ENDCASE;
            RETURN};

        UpdateLeaves: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[v: Tree.Link] = {
            IF root = Tree.Null THEN v _ Tree.Null
            ELSE
                WITH root SELECT TreeOps.GetTag[root] FROM
                    subtree => {
                        node: Tree.Index = index;
                        FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
                            tb[node].son[i] _ map[tb[node].son[i]];
                            ENDLOOP;
                        v _ root};
                    ENDCASE => v _ map[root];
            RETURN};


    <<procedures for list testing>>

        ListLength: PUBLIC PROC[t: Tree.Link] RETURNS[CARDINAL] = {
            IF t = Tree.Null THEN RETURN[0];
            WITH t SELECT TreeOps.GetTag[t] FROM
                subtree => {
                    node: Tree.Index = index;
                    RETURN[IF tb[node].name # $list THEN 1 ELSE tb[node].nSons]};
                ENDCASE => RETURN[1]
            };

        ListHead: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
            IF t = Tree.Null THEN RETURN[Tree.Null];
            WITH t SELECT TreeOps.GetTag[t] FROM
                subtree => {
                    node: Tree.Index = index;
                    RETURN[SELECT TRUE FROM
                        (tb[node].name # $list) => t,
                        (tb[node].nSons # 0) => tb[node].son[1],
                        ENDCASE => Tree.Null]};
                ENDCASE => RETURN[t]
            };

        ListTail: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
            IF t = Tree.Null THEN RETURN[Tree.Null];
            WITH t SELECT TreeOps.GetTag[t] FROM
                subtree => {
                    node: Tree.Index = index;
                    RETURN[SELECT TRUE FROM
                        (tb[node].name # $list) => t,
                        (tb[node].nSons # 0) => tb[node].son[ListLength[t]],
                        ENDCASE => Tree.Null]};
                ENDCASE => RETURN[t]
            };


    <<procedures for list traversal>>

        ScanList: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
            IF root # Tree.Null THEN
                WITH root SELECT TreeOps.GetTag[root] FROM
                    subtree => {
                        node: Tree.Index = index;
                        IF tb[node].name = $list THEN
                            FOR i: CARDINAL IN [1..tb[node].nSons] DO action[tb[node].son[i]] ENDLOOP
                        ELSE action[root]};
                    ENDCASE => action[root]
            };

        ReverseScanList: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
            IF root # Tree.Null THEN
                WITH root SELECT TreeOps.GetTag[root] FROM
                    subtree => {
                        node: Tree.Index = index;
                        IF tb[node].name = $list THEN
                            FOR i: CARDINAL DECREASING IN [1..tb[node].nSons] DO
                                action[tb[node].son[i]] ENDLOOP
                        ELSE action[root]};
                    ENDCASE => action[root]
            };

        SearchList: PUBLIC PROC[root: Tree.Link, test: Tree.Test] = {
            IF root # Tree.Null THEN
                WITH root SELECT TreeOps.GetTag[root] FROM
                    subtree => {
                        node: Tree.Index = index;
                        IF tb[node].name = $list THEN
                            FOR i: CARDINAL IN [1..tb[node].nSons] DO
                                IF test[tb[node].son[i]] THEN EXIT
                                ENDLOOP
                        ELSE [] _ test[root]};
                    ENDCASE => [] _ test[root]
            };

        UpdateList: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[Tree.Link] = {
            IF root = Tree.Null THEN RETURN[Tree.Null];
            WITH root SELECT TreeOps.GetTag[root] FROM
                subtree => {
                    node: Tree.Index = index;
                    IF tb[node].name = $list THEN {
                        FOR i: CARDINAL IN [1..tb[node].nSons] DO
                            tb[node].son[i] _ map[tb[node].son[i]];
                            ENDLOOP;
                        RETURN[root]}
                    ELSE RETURN[map[root]]};
                ENDCASE => RETURN[map[root]]    
            };

        ReverseUpdateList: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[Tree.Link] = {
            IF root = Tree.Null THEN RETURN[Tree.Null];
            WITH root SELECT TreeOps.GetTag[root] FROM
                subtree => {
                    node: Tree.Index = index;
                    IF tb[node].name # $list THEN RETURN[map[root]];
                    FOR i: CARDINAL DECREASING IN [1..ListLength[root]] DO
                        tb[node].son[i] _ map[tb[node].son[i]] ENDLOOP;
                    RETURN[root]};
                ENDCASE => RETURN[map[root]]    
            };


    <<cross-table tree manipulation>>

        CopyTree: PUBLIC PROC[root: Tree.Id, map: Tree.Map] RETURNS[v: Tree.Link] = {
            WITH root.link SELECT TreeOps.GetTag[root.link] FROM
                subtree => {
                    sNode: Tree.Index = index;
                    IF sNode = Tree.nullIndex THEN v _ Tree.Null
                    ELSE {
                        size: CARDINAL = NodeSize[root.baseP, sNode];
                        dNode: Tree.Index = table.GetChunk[size, Tree.treeType];
                        tb[dNode].name _ root.baseP^[sNode].name;
                        tb[dNode].shared _ FALSE;
                        tb[dNode].nSons _ root.baseP^[sNode].nSons;
                        tb[dNode].info _ root.baseP^[sNode].info;
                        tb[dNode].attr1 _ root.baseP^[sNode].attr1;
                        tb[dNode].attr2 _ root.baseP^[sNode].attr2;
                        tb[dNode].attr3 _ root.baseP^[sNode].attr3;
                        FOR i: CARDINAL IN [1..(size-Tree.Node.SIZE)/Tree.Link.SIZE] DO
                            tb[dNode].son[i] _ map[root.baseP^[sNode].son[i]];
                            ENDLOOP;
                        v _ [subtree[index: dNode]]}};
                ENDCASE => v _ map[root.link];
            RETURN};

        IdentityMap: PUBLIC Tree.Map = {
            RETURN[IF IsTree[t] AND ~Shared[t]
                THEN CopyTree[[baseP:@tb, link:t], IdentityMap]
                ELSE t]    
            };


        NodeSize: PUBLIC PROC[baseP: Tree.Finger, node: Tree.Index] RETURNS[size: CARDINAL] = {
            RETURN[IF node = Tree.nullIndex
                THEN 0
                ELSE Tree.Node[baseP^[node].nSons].SIZE]
            };

        }.

