zOs/REXX.O08/MOLD
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a, delta
if delta = '' then
m.a = m.a + 1
else
m.a = m.a + delta
return m.a
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg a, delta
if symbol('m.a') <> 'VAR' then
m.a = 0
return mInc(a)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg a
return m.m.key.a
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg a
if symbol('m.a.0') == 'VAR' then
return m.a.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg a
dx = lastPos('.', a)
if dx <= 1 then
return ''
else
return left(a, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg a, Ky, val
if a == '' then
a = 'm.root.' || mIncD('m.root.0')
m.a = val
m.m.key.a = Ky
m.a.0 = 0
return a
endProcedure mRoot
/*--- add one or several values to stem m.a --------------------------*/
mAdd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'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 a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
m.a.ix.0 = 0
end
m.a.0 = ix
return a'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.a -----------------------------*/
mAddKy: procedure expose m.
parse arg a, Ky, val
nn = mAddNd(a, val)
m.m.key.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg a, ky, val
if symbol('m.m.index.a.key.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(a, val)
m.m.key.nn = ky
m.m.index.a.key.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg a, Ky, val
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
m.ch = val
return ch
end
else do
return mAddK1(a, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg a, ky
if symbol('m.m.index.a.key.ky') == 'VAR' then
return m.m.index.a.key.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg a, Ky
if symbol('m.m.index.a.key.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' a
ch = m.m.index.a.key.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()
a = arg(ax)
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.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 a, seq
if symbol('m.a.seq') ^== 'VAR' then
return ''
else
return a'.'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.m.key.ch
drop m.m.index.pa.key.ky m.key.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.m.key.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.m.key.sCh
if symbol('m.m.index.src.key.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 a
pa = mPar(a)
t = 'node' a 'pa='pa
if symbol('m.a') == 'VAR' then
t = t 'va='m.a
if symbol('m.a.0') == 'VAR' then
t = t 'size='m.a.0
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
t = t 'ky='ky
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t = t 'index='m.m.index.pa.key.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg a, lv
if lv = '' then
lv = 0
t = left('', lv)a
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
pa = mPar(a)
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.a, 't')
do cx=1 to mSize(a)
call mShow mAtSq(a, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/