zOs/REXX.O08/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
    return
endProcedure mapIni

/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
    return mapReset('MAP.'mInc('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
    upper opt
    if opt = '=' then
        st = a
    else if opt = 'K' then
        st = 'MAP.KEYS.'a
    else
        st = opt
    m.map.keys.a = st
    if st ^== '' then
        m.st.0 = 0
    if abbrev(a, 'MAP.') then
         m.map.loKy.a.0 = 0
    return a
endProcedure

/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
    vv = mapValAdr(a, ky, 'a')
    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 = mapValAdr(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 mapValAdr(a, ky) ^== ''
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 =  mapValAdr(a, ky)
    if vv ^== '' then
        return m.vv
    else if arg() >= 3 then
        return arg(3)
    else
        call 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 = mapValAdr(a, ky)
    if vv == '' then
        return ''
    if m.map.keys ^== '' then
        call err 'not implemented mapRemove('a',' ky')'
    val = m.a.vv
    drop m.a.ky
    return val
endProcedure mapRemove

/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
    st = mapKeys(a)
    do kx=1 to m.st.0
        k = m.st.kx
        if length(k) > 200 then do
            k = left(k, 201)
            if symbol('m.a.k') == 'VAR' then/* ist noch hier */
                call mapClear m.a.k
            end
        drop m.a.k m.st.kx
        end
    m.st.0 = 0
    return a
endProcedure mapClear

/*--- return the value pointer for a key, '' if non existing
             with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
    a = pA
    ky = pKy
    do forever
        if length(ky) <= 200 then do
            if symbol('m.a.ky') ^== 'VAR' then
                leave
            if fun == 'a' then
                call err 'duplicate key' pKy 'in map' pA
            return a'.'ky
            end
        k1 = left(ky, 201)
        if symbol('m.a.k1') ^== 'VAR' then
            leave
        a = m.a.k1
        ky = substr(ky, 202)
        end
    if fun == '' then
        return ''
    opt = left('K', m.map.keys.pA ^== '')
    if opt == 'K' then
        call mAdd m.map.Keys.pA, pKy
    do while length(ky) > 200
        k1 = left(ky, 201)
        n = mapNew(opt)
        m.a.k1 = n
        if a ^== pA & opt == 'K' then
            call mAdd m.map.keys.a, ky
        a = n
        ky = substr(ky, 202)
        end
    return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/