
    <<TreePack.Mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 16, 1986 1:12:31 pm PST>>
        <<Paul Rovner, September 7, 1983 12:12 am>>
        <<Russ Atkinson (RRA) March 6, 1985 10:26:01 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
        Literals USING [LitIndex],
        Symbols: TYPE USING [HTIndex, ISEIndex],
        Tree: TYPE USING [AttrId, Base, Finger, Id, Info, Index, Link, Map, Node, NodeName, Scan, Test, maxNSons, Null, NullIndex, 
        treeType],
        TreeOps: TYPE USING [];

    TreePack: PROGRAM
        IMPORTS Alloc EXPORTS TreeOps = {

        endIndex: Tree.Index = Tree.Index.LAST;
        endMark: Tree.Link = [subtree[index: endIndex]];

        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.SIZE+nSons*Tree.Link.SIZE, Tree.treeType];
            i: CARDINAL;
            tb[node].name _ name;  tb[node].nSons _ nSons;
            tb[node].info _ 0;  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 => {
                    IF nSons IN (0..Tree.maxNSons] THEN
                        node _ table.GetChunk[Tree.Node.SIZE+nSons*Tree.Link.SIZE, Tree.treeType]
                    ELSE {
                        node _ table.GetChunk[Tree.Node.SIZE+(nSons+1)*Tree.Link.SIZE, Tree.treeType];
                        tb[node].son[nSons+1] _ endMark};
                    tb[node].name _ $list;
                    tb[node].info _ 0;  tb[node].shared _ FALSE;
                    tb[node].attr1 _ tb[node].attr2 _ tb[node].attr3 _ FALSE;
                    tb[node].nSons _ IF nSons IN (0..Tree.maxNSons] THEN nSons ELSE 0;
                    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 {
                node: Tree.Index = table.GetChunk[Tree.Node.SIZE+Tree.Link.SIZE, Tree.treeType];
                tb[node].name _ $list;
                tb[node].info _ 0;  tb[node].shared _ FALSE;
                tb[node].attr1 _ tb[node].attr2 _ tb[node].attr3 _ FALSE;
                tb[node].nSons _ size.ABS;
                tb[node].son[1] _ IF size = 0 THEN endMark ELSE PopTree[];
                PushTree[[subtree[index: node]]]}
            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.LitIndex] = {PushTree[[literal[index: lti]]]};


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

        SetAttr: PUBLIC PROC[attr: Tree.AttrId, value: BOOL] = {
            WITH stack[sI-1] SELECT FROM
                v: Tree.Link.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;
                IF tb[node].name # $list OR n # 0 THEN
                    FOR i _ 1, i+1 WHILE i <= n DO
                        WITH tb[node].son[i] SELECT FROM
                            t: Tree.Link.subtree => FreeNode[t.index];
                            ENDCASE;
                        ENDLOOP
                ELSE {
                    n _ 1;
                    FOR i _ 1, i+1 UNTIL tb[node].son[i] = endMark DO
                        WITH tb[node].son[i] SELECT FROM
                            t: Tree.Link.subtree => FreeNode[t.index];
                            ENDCASE;
                        n _ n+1;
                        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 FROM subtree => FreeNode[index] ENDCASE;
            RETURN[Tree.Null]};


    <<procedures for tree testing>>

        GetHash: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.HTIndex] = {
            RETURN[NARROW[t, Tree.Link.hash].index]};

        GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Index] = {
            RETURN[NARROW[t, Tree.Link.subtree].index]};

        GetSe: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.ISEIndex] = {
            RETURN[NARROW[t, Tree.Link.symbol].index]};

        NthSon: PUBLIC PROC[t: Tree.Link, n: CARDINAL] RETURNS[Tree.Link] = {
            RETURN[IF t = Tree.Null
                THEN ERROR
                ELSE tb[NARROW[t, Tree.Link.subtree].index].son[n]]};

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

        GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] = {
            node: Tree.Index = NARROW[t, Tree.Link.subtree].index;
            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, Tree.Link.subtree].index;
            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, Tree.Link.subtree].index].info
                ELSE ERROR]};

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

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

        MarkShared: PUBLIC PROC[t: Tree.Link, shared: BOOL] = {
            WITH t SELECT FROM
                s: Tree.Link.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, endIndex => 0,
                ENDCASE => IF tb[node].name = $list AND tb[node].nSons = 0
                    THEN ListLength[[subtree[index: node]]]
                    ELSE tb[node].nSons]};


    <<procedures for tree traversal>>

        ScanSons: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
            IF root # Tree.Null THEN
                WITH root SELECT FROM
                    subtree => {
                        node: Tree.Index = index;
                        FOR i: CARDINAL IN [1 .. SonCount[node]] 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 FROM
                    subtree => {
                        node: Tree.Index = index;
                        FOR i: CARDINAL IN [1 .. SonCount[node]] 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 FROM
                subtree => {
                    node: Tree.Index = index;
                    n: CARDINAL;
                    IF tb[node].name # $list THEN RETURN[1];
                    n _ tb[node].nSons;
                    IF n # 0 THEN RETURN[n];
                    FOR i: CARDINAL _ 1, i+1 UNTIL tb[node].son[i] = endMark DO n _ n+1 ENDLOOP;
                    RETURN[n]};
                ENDCASE => RETURN[1]};

        ListHead: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
            IF t = Tree.Null THEN RETURN[Tree.Null];
            WITH t SELECT FROM
                subtree => {
                    node: Tree.Index = index;
                    RETURN[SELECT TRUE FROM
                        (tb[node].name # $list) => t,
                        (tb[node].son[1] # endMark) => 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 FROM
                subtree => {
                    node: Tree.Index = index;
                    RETURN[SELECT TRUE FROM
                        (tb[node].name # $list) => t,
                        (tb[node].son[1] # endMark) => 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 FROM
                    subtree => {
                        node: Tree.Index = index;
                        i, n: CARDINAL;
                        t: Tree.Link;
                        IF tb[node].name # $list THEN action[root]
                        ELSE IF (n _ tb[node].nSons) # 0 THEN
                            FOR i _ 1, i+1 WHILE i <= n DO action[tb[node].son[i]] ENDLOOP
                        ELSE
                            FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO action[t] ENDLOOP};
                    ENDCASE => action[root]};

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

        SearchList: PUBLIC PROC[root: Tree.Link, test: Tree.Test] = {
            IF root # Tree.Null THEN
                WITH root SELECT FROM
                    subtree => {
                        node: Tree.Index = index;
                        i, n: CARDINAL;
                        t: Tree.Link;
                        IF tb[node].name # $list THEN [] _ test[root]
                        ELSE IF (n _ tb[node].nSons) # 0 THEN
                            FOR i _ 1, i+1 WHILE i <= n DO IF test[tb[node].son[i]] THEN EXIT ENDLOOP
                        ELSE
                            FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO
                                IF test[t] THEN EXIT ENDLOOP};
                    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 FROM
                subtree => {
                    node: Tree.Index = index;
                    i, n: CARDINAL;
                    t: Tree.Link;
                    IF tb[node].name # $list THEN RETURN[map[root]];
                    IF (n _ tb[node].nSons) # 0 THEN
                        FOR i _ 1, i+1 WHILE i <= n DO tb[node].son[i] _ map[tb[node].son[i]] ENDLOOP
                    ELSE
                        FOR i _ 1, i+1 UNTIL (t_tb[node].son[i]) = endMark DO
                            tb[node].son[i] _ map[t] ENDLOOP;
                    RETURN[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 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 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];
                        t: Tree.Link;
                        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] _ IF (t_root.baseP^[sNode].son[i]) = endMark
                                THEN endMark
                                ELSE map[t];
                            ENDLOOP;
                        v _ [subtree[index: dNode]]}};
                ENDCASE => v _ map[root.link];
            RETURN};

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


        NodeSize: PUBLIC PROC[baseP: Tree.Finger, node: Tree.Index] RETURNS[size: CARDINAL] = {
            IF node = Tree.NullIndex THEN size _ 0
            ELSE IF baseP^[node].name # $list OR baseP^[node].nSons # 0 THEN
                size _ Tree.Node.SIZE + baseP^[node].nSons*Tree.Link.SIZE
            ELSE {
                size _ Tree.Node.SIZE + Tree.Link.SIZE;
                FOR i: CARDINAL _ 1, i+1 UNTIL baseP^[node].son[i] = endMark DO
                    size _ size + Tree.Link.SIZE ENDLOOP};
            RETURN};

        }.