
    <<SMTreeImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, October 21, 1985 3:25:15 pm PDT>>

    DIRECTORY
        Tree: TYPE USING [
            AttrId, Ext, Handle, Id, Info, Link, Name, Node, NodeName, SonId, null],
        TreeOps USING [Map, Scan, Test];

    SMTreeImpl: CEDAR PROGRAM EXPORTS TreeOps ~ {
        OPEN Tree;

        LinkStack: TYPE~RECORD[SEQUENCE size: NAT OF Tree.Link];
        stackIncr: NAT~128;

        TreeManager: PUBLIC TYPE~RECORD[
            z: ZONE _,
            stack: REF LinkStack _ NIL,
            sI: NAT _ 0,
            initialized: BOOL _ FALSE,
            visiting: BOOL _ FALSE,
            mark: BOOL _ FALSE];

        TM: TYPE~REF TreeManager;


        Create: PUBLIC PROC[zone: ZONE] RETURNS[TM]~{
            tm: TM ~ zone.NEW[TreeManager _ [z~zone]];
            RETURN[tm]};

        Initialize: PUBLIC PROC[tm: TM]~{
            IF tm.initialized THEN Finalize[tm];
            tm.stack _ AllocStack[tm, stackIncr];
            tm.sI _ 0;
            tm.mark _ FALSE;
            tm.initialized _ TRUE};

        Reset: PUBLIC PROC[tm: TM]~{
            IF tm.initialized AND tm.stack.size > 2*stackIncr THEN {
                tm.stack _ AllocStack[tm, stackIncr]}
            };

        Finalize: PUBLIC PROC[tm: TM]~{
            tm.initialized _ FALSE;
            tm.stack _ NIL};


        AllocStack: PROC[tm: TM, size: NAT, forceNew: BOOL_FALSE]
              RETURNS[st: REF LinkStack] ~ {
            st _ (IF forceNew THEN NIL ELSE tm.stack);
            IF st = NIL OR st.size < size THEN st _ (tm.z).NEW[LinkStack[size]]};

        ExpandStack: PROC[tm: TM]~{
            newStack: REF LinkStack ~ AllocStack[tm, tm.stack.size+stackIncr, TRUE];
            FOR i: NAT IN [0 .. tm.stack.size) DO newStack[i] _ tm.stack[i] ENDLOOP;
            tm.stack _ newStack};


        Zone: PUBLIC PROC[tm: TM] RETURNS[ZONE]~{RETURN [tm.z]};


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

        PopTree: PUBLIC PROC[tm: TM] RETURNS[Tree.Link]~{
            RETURN [tm.stack[tm.sI_tm.sI-1]]};


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

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


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

        PushNode: PUBLIC PROC[tm: TM, name: Tree.NodeName, count: INTEGER] ~ {
            nSons: NAT = count.ABS;
            node: Tree.Handle~(tm.z).NEW[Tree.Node[nSons]_[name~name, visited~tm.mark, son~]];
            IF count >= 0 THEN
                FOR i: Tree.SonId DECREASING IN [1..nSons] DO
                    node.son[i] _ tm.stack[tm.sI_tm.sI-1] ENDLOOP
            ELSE
                FOR i: Tree.SonId IN [1..nSons] DO
                    node.son[i] _ tm.stack[tm.sI_tm.sI-1] ENDLOOP;
            IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
            tm.stack[tm.sI] _ node;  tm.sI _ tm.sI+1};


        SetAttr: PUBLIC PROC[tm: TM, attr: Tree.AttrId, value: BOOL]~{
            FOR node: Tree.Handle _ NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
                IF node.name # $locator THEN {
                    node.attrs[attr] _ value; EXIT};
                ENDLOOP
            };

        SetExt: PUBLIC PROC[tm: TM, ext: Tree.Ext]~{
            FOR node: Tree.Handle _ NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
                IF node.name # $locator THEN {
                    node.ext _ ext; EXIT};
                ENDLOOP
            };

        SetInfo: PUBLIC PROC[tm: TM, info: Tree.Info]~{
            WITH tm.stack[tm.sI-1] SELECT FROM
                node: Tree.Handle => node.info _ info;
                ENDCASE => ERROR
            };


        <<structure extraction>>

        GetName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Name]~{
            RETURN [WITH t SELECT FROM
                name: Tree.Name => name,
                node: Tree.Handle =>
                    IF node.name # $locator THEN ERROR ELSE GetName[node.son[1]],
                ENDCASE => ERROR]
            };

        GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Handle]~{
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node ELSE GetNode[node.son[1]],
                ENDCASE => ERROR]
            };

        GetId: PUBLIC PROC[t: Tree.Link] RETURNS [Tree.Id]~{
            RETURN [WITH t SELECT FROM
                id: Tree.Id => id,
                node: Tree.Handle =>
                    IF node.name # $locator THEN ERROR ELSE GetId[node.son[1]],
                ENDCASE => ERROR]
            };


        NSons: PUBLIC PROC[t: Tree.Link] RETURNS[NAT] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.sonLimit-1 ELSE NSons[node.son[1]],
                ENDCASE => 0]
            };

        NthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId] RETURNS[Tree.Link] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.son[n] ELSE NthSon[node.son[1], n],
                ENDCASE => ERROR]
            };

        PutNthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId, v: Tree.Link] ~ {
            WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.son[n] _ v
                    ELSE PutNthSon[node.son[1], n, v];
                ENDCASE => ERROR
            };

        OpName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.NodeName] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.name ELSE OpName[node.son[1]],
                ENDCASE => $none]
            };

        GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.attrs[attr] ELSE GetAttr[node.son[1], attr],
                ENDCASE => ERROR]
            };

        PutAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId, value: BOOL] ~ {
            WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.attrs[attr] _ value
                    ELSE PutAttr[node.son[1], attr, value];
                ENDCASE => ERROR
            };

        GetInfo: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Info] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle => node.info,
                ENDCASE => ERROR]
            };

        PutInfo: PUBLIC PROC [t: Tree.Link, value: Tree.Info] = {
            WITH t SELECT FROM
                node: Tree.Handle => node.info _ value;
                ENDCASE => ERROR
            };

        GetExt: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Ext] ~ {
            RETURN [WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.ext ELSE GetExt[node.son[1]],
                ENDCASE => ERROR]
            };

        PutExt: PUBLIC PROC[t: Tree.Link, ext: Tree.Ext] ~ {
            WITH t SELECT FROM
                node: Tree.Handle =>
                    IF node.name # $locator THEN node.ext _ ext
                    ELSE PutExt[node.son[1], ext];
                ENDCASE => ERROR
            };


        <<procedures for tree traversal>>


        StartVisit: PUBLIC PROC[tm: TM] RETURNS[BOOL] ~ {
            IF tm.visiting THEN ERROR;
            tm.visiting _ TRUE;  tm.mark _ ~tm.mark;
            RETURN [tm.mark]};

        EndVisit: PUBLIC PROC[tm: TM] ~ {
            tm.visiting _ FALSE};


        ScanSons: PUBLIC PROC[root: Tree.Link, action: TreeOps.Scan] ~ {
            WITH root SELECT FROM
                node: Tree.Handle =>
                    FOR i: Tree.SonId IN [1 .. node.sonLimit) DO action[node.son[i]] ENDLOOP;
                ENDCASE;
            };

        SearchSons: PUBLIC PROC[root: Tree.Link, test: TreeOps.Test] RETURNS[BOOL] ~ {
            WITH root SELECT FROM
                node: Tree.Handle =>
                    FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
                        IF test[node.son[i]] THEN RETURN[TRUE]
                        ENDLOOP;
                ENDCASE;
            RETURN[FALSE]};

        UpdateSons: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map] ~ {
            WITH root SELECT FROM
                node: Tree.Handle =>
                    FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
                        node.son[i] _ map[tm, node.son[i]]
                        ENDLOOP;
                ENDCASE;
            };

        UpdateLeaves: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]
              RETURNS[v: Tree.Link] ~ {
            IF root = Tree.null THEN v _ Tree.null
            ELSE
                WITH root SELECT FROM
                    node: Tree.Handle => {
                        FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
                            node.son[i] _ map[tm, node.son[i]] ENDLOOP;
                        v _ root};
                    ENDCASE => v _ map[tm, root];
            RETURN};


    <<cross-table tree manipulation>>

        CopyTree: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]
              RETURNS[v: Tree.Link] ~ {
            IF root = Tree.null THEN v _ Tree.null
            ELSE
                WITH root SELECT FROM
                    sNode: Tree.Handle => {
                        dNode: Tree.Handle ~ (tm.z).NEW[Tree.Node[NSons[sNode]] _ [
                                   name~sNode.name,
                                   attrs~sNode.attrs,
                                   visited~tm.mark,
                                   info~sNode.info,
                                   son~]];
                        FOR i: Tree.SonId IN [1..sNode.sonLimit) DO
                            dNode.son[i] _ map[tm, sNode.son[i]] ENDLOOP;
                        v _ dNode}
                    ENDCASE => v _ map[tm, root];
            RETURN};

        IdentityMap: PUBLIC TreeOps.Map~{
            RETURN[IF ISTYPE[t, Tree.Handle] THEN CopyTree[tm, t, IdentityMap] ELSE t]};

        }.