zOs/REXX.O08/TREE2

treeRoot: procedure expose m.
parse arg ro, ky, va
    if ro == '' then
        ro = ooNew()
    m.ro = va
    m.ro.key = ky
    m.ro.0 = 0
    return ro
endProcedure treeRoot

treeAdd: procedure expose m.
parse arg pa, ky, va
    cx = m.pa.0 + 1
    m.pa.0 = cx
    m.pa.cx.0 = 0
    m.pa.cx = va
    m.pa.cx.key = ky
    return pa'.'cx
endProcedure treeAdd

mAddK1: procedure expose m.
parse arg pa, ky, va
    if symbol('m.pa.index.ky') == 'VAR' then
        call err 'add existing key' ky 'to node' pa
    ch = treeAdd(pa, ky, va)
    m.pa.index.ky = ch
    return ch
endProcedure mAddK1

mPut: procedure expose m.
parse arg pa, ky, va
    if symbol('m.pa.index.ky') == 'VAR' then do
        ch = m.pa.index.ky
        m.ch = va
        end
    else do
        call mAddK1 pa, ky, va
        end
    return
endProcedure mPut

mAtK1: procedure expose m.
parse arg pa, ky
    if symbol('m.pa.index.ky') ^== 'VAR' then
        return ''
    return m.pa.index.ky
endProcedure treeGetChild

mKy: procedure expose m.
parse arg nd
    return m.nd.key
endProcedure mKy

mPar: procedure expose m.
parse arg nd
    return left(nd, lastPos('.', nd) - 1)
endProcedure mPar

mVaAtK1: procedure expose m.
parse arg pa, ky
    if symbol('m.pa.index.ky') ^== 'VAR' then
        call err 'undefined key' ky 'for parent' pa
    ch = m.pa.index.ky
    return m.ch
endProcedure mVaAtK1

mFirst: procedure expose m.
parse arg ky, def
    do ax=3 to arg()
        pa = arg(ax)
        if symbol('m.pa.index.ky') == 'VAR' then do
            ch = m.pa.index.ky
            return m.ch
            end
        end
    return def
endProcedure mFirst

mAtSq: procedure expose m.
parse arg pa, no
    if symbol('m.pa.no') ^== 'VAR' then
        call err 'bad childNo' no 'for parent' pa
    return pa'.'no
endProcedure mAtSq

mSize: procedure expose m.
parse arg nd
    return m.nd.0
endProcedure mSize

mRemCh: procedure expose m.
parse arg pa, rmPar
    do cx=1 to m.pa.0
        ky = m.pa.cx.key
        drop m.pa.index.ky
        call mRemCh pa'.'cx, 1
        end
    m.pa.0 = 0
    if rmPar = 1 then do
        drop m.pa m.pa.key m.pa.0
        end
    return
endProcedure mRemCh

treeDeepCopy: procedure expose m.
parse arg dst, src, rm
    if rm ^== 0 then
        call mRemCh dst
    do sx=1 to m.src.0
        ky = m.src.sx.key
        if symbol('m.src.index.ky') == 'VAR' then
            ch = mAddK1(dst, ky, m.src.sx)
        else
            ch = treeAdd(dst, ky, m.src.sx)
        call treeDeepCopy ch, src'.'sx, 0
        end
    return dst
endProcedure treeDeepCopy

mShow: procedure expose m.
parse arg nd, lv
    if lv = '' then
        lv = 0
    say left('', lv)nd m.nd.key'='strip(m.nd, 't')
    if symbol('m.nd.0') == 'VAR' then do
        do cx=1 to m.nd.0
            call mShow nd'.'cx, lv+1
            end
        end
    return
endProcedure mShow
/* copy tree end   ****************************************************/