zOs/REXX.O08/TESTM

/*--- test -----------------------------------------------------------*/
r1 = mRoot(, 'r1', 'rootEins')
r2 = mRoot(, 'r2', 'rootZwei')
call mShow mPar(r2)
call mAdd r1, 'added:mAdd'
call mAdd r1, 'added:mAdd2'
call mAddKy r1, 'mAddKy', 'added:mAddKy a'
call mAddKy r1, 'mAddKy', 'added:mAddKy b'
call mAddK1 r1, 'mAddK1', 'added:mAddK1'
/* call mAddK1 r1, 'mAddK1', 'added:mAddK2' */
r11 = mAddKy(r1, 'mAddKy', 'added:mAddKy')
say '*** show2'
call mShow mPar(r2)
say 'r1[mAddKy]' mAtK1(r1, 'mAddKy')
say 'r1[mAddK1]' mAtK1(r1, 'mAddK1')':' mVaAtK1(r1, 'mAddK1')
call mAddK1 r11, 1, 111
call mAddK1 r11, 2, 112
call mAddK1 r11, 3, 113
call mAddK1 r11, 4, 114
call mPut    r11, 3, 'drei put'
call mPut    r11, 5, 'fuenf put'
say 'r11[2]' mVaAtK1(r11, 2) '[4]' mVaAtK1(r11, 4)
say '*** show3'
call mShow mPar(r2)
say 'mAddTree root2, root1'
call mAddTree r2, r1
r23 = mAtSq(r2, 3)
say 'mAddTree' r23', root1'
call mAddTree r23, r1
say '*** show4'
call mShow mPar(r2)
call mShowNd r2
call mShowNd r23
r23i = mAtK1(r23, 'mAddK1')
call mShowNd r23i
say 'mRemCh r2'
call mRemCh r2
call mShowNd r2
call mShowNd r23
call mShowNd r23i
say '*** show5'
call mShow mPar(r2)
exit

/* copy m begin ********************************************************
    stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
    parse arg m, delta
    if delta = '' then
        m.m = m.m + 1
    else
        m.m = m.m + delta
    return m.m
endProcedure mInc

/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
    parse arg m, delta
    if symbol('m.m') <> 'VAR' then
        m.m = 0
    return mInc(m)
endProcedure mIncD

/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
    parse arg m
    return m.mKey.m
endProcedure mKy

/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
    parse arg m
    if symbol('m.m.0') == 'VAR' then
        return m.m.0
    else
        return 0
endProcedure mSize

/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
    dx = lastPos('.', m)
    if dx <= 1 then
        return ''
    else
        return left(m, dx - 1)
endProcedure mPar

/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
    if m == '' then
        m = 'mRoot.' || mIncD('mRoot.0')
    m.m = val
    m.mKey.m = Ky
    m.m.0 = 0
    return m
endProcedure mRoot

/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
    parse arg m
    ix = mSize(m)
    do ax = 2 to arg()
        ix = ix + 1
        m.m.ix = arg(ax)
        end
    m.m.0 = ix
    return m'.'ix
endProcedure mAdd

/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
    parse arg dst, src, begX, endX
    if begX = '' then
        begX = 1
    if endX = '' then
        endX = mSize(src)
    dx = mSize(dst)
    do sx = begX to endX
        dx = dx + 1
        m.dst.dx = m.src.sx
        end
    m.dst.0 = dx
    return dst
endProcedure mAddSeq

/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
    parse arg m
    ix = mSize(m)
    do ax = 2 to arg()
        ix = ix + 1
        m.m.ix = arg(ax)
        m.m.ix.0 = 0
        end
    m.m.0 = ix
    return m'.'ix
endProcedure mAddNd

/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
    parse arg m, Ky, val
    nn = mAddNd(m, val)
    m.mKey.nn = Ky
    return nn
endProcedure mAddKy

/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
    parse arg m, ky, val
    if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
        call err 'duplicate Ky' ky 'for node' m
    nn = mAddNd(m, val)
    m.mKey.nn = ky
    m.mIndex.m.mKey.ky = nn
    return nn
endProcedure mAddK1

/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
    if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
        ch = m.mIndex.m.mKey.Ky
        m.ch = val
        return ch
        end
    else do
        return mAddK1(m, Ky, val)
        end
    return
endProcedure mPut

/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
    if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
        return m.mIndex.m.mKey.ky
    else
        return ''
endProcedure mAtK1

/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
    if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
        call err 'no Ky' Ky 'at node' m
    ch = m.mIndex.m.mKey.Ky
    return m.ch
endProcedure mVaAtK1

/*--- return the value of the first defined ky in the list of nodes
      def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
    do ax=3 to arg()
        m = arg(ax)
        if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
            ch = m.mIndex.m.mKey.Ky
            return m.ch
            end
        end
    return def
endProcedure mFirst

/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
    if symbol('m.m.seq') ^== 'VAR' then
        return ''
    else
        return m'.'seq
endProcedure mAtSq

/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
    if nwSz = '' then
        nwSz = 0
    do cx=nwSz+1 to mSize(pa)
        ch = pa'.'cx
        call mRemCh ch
        ky = m.mKey.ch
        drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
        end
    m.pa.0 = nwSz
    return pa
endProcedure mRemCh

/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
    if begX = '' then
        begX = 1
    if endX = '' then
        endX = mSize(src)
    do sx=begX to endX
        sCh = src'.'sx
        if symbol('m.mKey.sCh') ^= 'VAR' then do
            dCh = mAddNd(dst, m.sCh)
            end
        else do
            ky = m.mKey.sCh
            if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
                dCh = mAddKy(dst, ky, m.sCh)
            else
                dCh = mAddK1(dst, ky, m.sCh)
            end
        call mAddTree dCh, sCh
        end
    return dst
endProcedure mAddTree

/*--- show from one node everything that is defined) -----------------*/
mShowNd: procedure expose m.
parse arg m
    pa = mPar(m)
    t = 'node' m 'pa='pa
    if symbol('m.m') == 'VAR' then
        t = t 'va='m.m
    if symbol('m.m.0') == 'VAR' then
        t = t 'size='m.m.0
    if symbol('m.mKey.m') == 'VAR' then do
        ky = m.mKey.m
        t = t 'ky='ky
        if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
            t = t 'index='m.mIndex.pa.mKey.ky
        end
    say t
    return
endProcedure mShowNd

/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
    if lv = '' then
        lv = 0
    t = left('', lv)m
    if symbol('m.mKey.m') == 'VAR' then do
        ky = m.mKey.m
        pa = mPar(m)
        if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
            t= t ky '>'
        else
            t= t ky '='
        end
    say t strip(m.m, 't')
    do cx=1 to mSize(m)
        call mShow mAtSq(m, cx), lv+1
        end
    return
endProcedure treeShow
/* copy m end *********************************************************/