rexx/step2_eval.rexx

   1 call main
   2 exit
   3
   4 #include "readline.rexx"
   5 #include "reader.rexx"
   6 #include "printer.rexx"
   7 #include "types.rexx"
   8
   9 read: procedure expose values. err /* read(str) */
  10   return read_str(arg(1))
  11
  12 eval_ast: procedure expose values. env. err /* eval_ast(ast) */
  13   ast = arg(1)
  14   type = obj_type(ast)
  15   val = obj_val(ast)
  16   select
  17     when type == "symb" then do
  18       varname = val
  19       if env.varname == "" then do
  20         err = "'" || varname || "' not found"
  21         return "ERR"
  22       end
  23       return env.varname
  24     end
  25     when type == "list" then do
  26       res = ""
  27       do i=1 to words(val)
  28         element = eval(word(val, i))
  29         if element == "ERR" then return "ERR"
  30         if i > 1 then
  31           res = res || " " || element
  32         else
  33           res = element
  34       end
  35       return new_list(res)
  36     end
  37     when type == "vect" then do
  38       res = ""
  39       do i=1 to words(val)
  40         element = eval(word(val, i))
  41         if element == "ERR" then return "ERR"
  42         if i > 1 then
  43           res = res || " " || element
  44         else
  45           res = element
  46       end
  47       return new_vector(res)
  48     end
  49     when type == "hash" then do
  50       res = ""
  51       do i=1 to words(val)
  52         element = eval(word(val, i))
  53         if element == "ERR" then return "ERR"
  54         if i > 1 then
  55           res = res || " " || element
  56         else
  57           res = element
  58       end
  59       return new_hashmap(res)
  60     end
  61     otherwise
  62       return ast
  63     end
  64
  65 eval: procedure expose values. env. err /* eval(ast) */
  66   ast = arg(1)
  67   if \list?(ast) then return eval_ast(ast)
  68   astval = obj_val(ast)
  69   if words(astval) == 0 then return ast
  70   lst_obj = eval_ast(ast)
  71   if lst_obj == "ERR" then return "ERR"
  72   lst = obj_val(lst_obj)
  73   f = word(lst, 1)
  74   call_args = subword(lst, 2)
  75   call_list = ""
  76   do i=1 to words(call_args)
  77     element = '"' || word(call_args, i) || '"'
  78     if i > 1 then
  79       call_list = call_list || ', ' || element
  80     else
  81       call_list = element
  82   end
  83   res = ""
  84   interpret "res = " || f || "(" || call_list || ")"
  85   return res
  86
  87 print: procedure expose values. /* print(ast) */
  88   return pr_str(arg(1), 1)
  89
  90 rep: procedure expose values. env. err /* rep(str) */
  91   ast = read(arg(1))
  92   if ast == "ERR" then return "ERR"
  93   exp = eval(ast)
  94   if exp == "ERR" then return "ERR"
  95   return print(exp)
  96
  97 mal_add: procedure expose values. /* mal_add(a, b) */
  98   return new_number(obj_val(arg(1)) + obj_val(arg(2)))
  99
 100 mal_sub: procedure expose values. /* mal_sub(a, b) */
 101   return new_number(obj_val(arg(1)) - obj_val(arg(2)))
 102
 103 mal_mul: procedure expose values. /* mal_mul(a, b) */
 104   return new_number(obj_val(arg(1)) * obj_val(arg(2)))
 105
 106 mal_div: procedure expose values. /* mal_div(a, b) */
 107   return new_number(obj_val(arg(1)) / obj_val(arg(2)))
 108
 109 main:
 110   values. = ""
 111   values.0 = 0
 112   env. = ""
 113   key = "+" ; env.key = "mal_add"
 114   key = "-" ; env.key = "mal_sub"
 115   key = "*" ; env.key = "mal_mul"
 116   key = "/" ; env.key = "mal_div"
 117   err = ""
 118   do while lines() > 0 /* 1 == 1 */
 119     input_line = readline('user> ')
 120     if length(input_line) > 0 then do
 121       res = rep(input_line)
 122       if res == "ERR" then
 123         call lineout , "Error: " || err
 124       else
 125         call lineout , res
 126     end
 127   end