zOs/REXX/MAP
/* copy map begin *****************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
**********************************************************************/
/*--- initialize the module -----------------------------------------*/
mapIni: procedure expose m.
if m.map_ini = 1 then
return
m.map_ini = 1
call mIni
m.map.0 = 0
m.map_inlineSearch = 1
call mapReset map_inlineName, map_inline
return
endProcedure mapIni
mapInline: procedure expose m.
parse arg pName, opt
if mapHasKey(map_inlineName, pName) then do
im = mapGet(map_inlineName, pName)
if pos('l', opt) < 1 & symbol('m.im.0') \== 'VAR' then do
m.im.0 = m.im.lEnd - m.im.lBegin - 1
do ix=1 to m.im.0
m.im.ix = strip(sourceline(ix+m.im.lBegin), 't')
end
end
return im
end
name = '/'
do lx = m.map_inlineSearch to sourceline()
if \ abbrev(sourceline(lx), '$') then
iterate
li = sourceline(lx)
s1 = pos('/', li)+ 1
if s1 < 3 | s1 > 4 then
iterate
s2 = pos('/', li, s1)
if s2 <= s1 then
iterate
if s1 == 3 then do
if name \== substr(li, s1, s2-s1) then
iterate
im = 'map_inline.' || (m.map_inline.0+1)
call mapAdd map_inlineName, name, im
m.im.lBegin = lBeg
m.im.lEnd = lx
m.im.mark = mrk
if name == pName then do
m.map_inlineSearch = lx+1
return mapInline(pName)
end
name = '/'
end
else if \ mapHasKey(map_inlineName,
, substr(li, s1, s2-s1)) then do
lBeg = lx
mrk = substr(li, 2, s1-3)
name = substr(li, s1, s2-s1)
end
else do
name = '/'
end
end
if pos('r', opt) > 0 then
return ''
return err('no inline data /'pName'/ found')
endProcedure mapInline
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
m.map.0 = m.map.0 + 1
return mapReset('MAP.'m.map.0 , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map_keys, '=' in a else in opt) -------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map_keys.a') == 'VAR' then
call mapClear a
if opt = '=' then
st = a
else if translate(opt) = 'K' then
st = 'MAP_KEYS.'a
else
st = opt
m.map_keys.a = st
if st \== '' then
m.st.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ---------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapAdr(a, ky, 'a')
if vv == '' then
return err('duplicate in mapAdd('a',' ky',' val')')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value --------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ---------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapAdr(a, ky, 'g') \== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ---------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapAdr(a, ky, 'g')
if vv \== '' then
return m.vv
else if arg() > 2 then
return arg(3)
else
return err('missing key in mapGet('a',' ky')')
endProcedure mapGet
/*--- return a stem of all keys -------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map_keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map_keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing --------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapAdr(a, ky, 'g')
if vv == '' then
return ''
if m.map_keys.a \== '' then do
trace ?R /* not tested yet ???wkTest */
k = m.map_keys.a
mx = m.k.0
do i=1 to mx
if m.k.i == ky then do
m.k.i = m.k.mx
m.k.0 = mx - 1
return
end
end
end
val = m.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries --------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
liLe = 247 - length(a)
do kx=1 to m.st.0
ky = m.st.kx
drop m.st.kx
if length(ky) < liLe then do
drop m.a.ky
end
else do
adr = mapAdr(a, ky, 'g')
if adr \== '' then do
ha = left(adr, length(adr) - 2)
do i = 1 to m.ha.0
vv = ha'v'i
drop m.ha.i m.vv
end
drop m.ha.0
end
end
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
f = 'g' return address if exists otherwise ''
'p' return address if exists otherwise newly added address
'a' return '' if exists otherwise newly added address --*/
mapAdr: procedure expose m.
parse arg a, ky, f
if length(ky) + length(a) < 247 then do
res = a'.'ky
if symbol('m.res') == 'VAR' then
return copies(res, f \== 'a')
else if f == 'g' then
return ''
end
else do
len = length(ky)
q = len % 2
ha = a'.'len || left(ky, 80) || substr(ky,
, len % 2 - 40, 85-length(len)-length(a)) || right(ky, 80)
if symbol('M.ha.0') == 'VAR' then do
do i=1 to m.ha.0
if m.ha.i == ky then
return copies(ha'v'i, f \== 'a')
end
end
else do
i = 1
end
if f == 'g' then
return ''
if i > 9 then
call err 'overflow long key' y 'in map' a 'hash' ha'.K.'i
m.ha.0 = i
m.ha.i = ky
res = ha'v'i
end
if m.map_keys.a \== '' then
call mAdd m.map_keys.a, ky
return res
endProcedure mapAdr
/* copy map end ******************************************************/