rexx/env.rexx

   1 #ifndef __env__
   2 #define __env__
   3
   4 env. = ""
   5 env.0 = 0
   6
   7 new_env_index: procedure expose env. /* new_env_index() */
   8   env.0 = env.0 + 1
   9   return env.0
  10
  11 new_env: procedure expose env. values. /* new_env(outer_env_idx [, binds, exprs]) */
  12   outer_env_idx = arg(1)
  13   binds = arg(2)
  14   exprs = arg(3)
  15   idx = new_env_index()
  16   env.idx.outer = outer_env_idx
  17   env.idx.data. = ""
  18   if binds \= "" then do
  19     binds_val = obj_val(binds)
  20     exprs_val = obj_val(exprs)
  21     do i=1 to words(binds_val)
  22       varname = obj_val(word(binds_val, i))
  23       if varname == "&" then do
  24         rest_args_list = new_list(subword(exprs_val, i))
  25         varname = obj_val(word(binds_val, i + 1))
  26         x = env_set(idx, varname, rest_args_list)
  27         leave
  28       end
  29       else
  30         x = env_set(idx, varname, word(exprs_val, i))
  31     end
  32   end
  33   return idx
  34
  35 env_set: procedure expose env. /* env_set(env_idx, key, val) */
  36   env_idx = arg(1)
  37   key = arg(2)
  38   val = arg(3)
  39   env.env_idx.data.key = val
  40   return val
  41
  42 env_find: procedure expose env. /* env_find(env_idx, key) */
  43   env_idx = arg(1)
  44   key = arg(2)
  45   if env.env_idx.data.key \= "" then return env_idx
  46   if env.env_idx.outer > 0 then return env_find(env.env_idx.outer, key)
  47   return 0
  48
  49 env_get: procedure expose env. err /* env_get(env_idx, key) */
  50   env_idx = arg(1)
  51   key = arg(2)
  52   found_env_idx = env_find(env_idx, key)
  53   if found_env_idx == 0 then do
  54     err = "'" || key || "' not found"
  55     return "ERR"
  56   end
  57   return env.found_env_idx.data.key
  58
  59 #endif