7 use WORK.pkg_readline.all;
12 architecture test of step2_eval is
13 procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is
15 read_str(str, ast, err);
16 end procedure mal_READ;
18 -- Forward declaration
19 procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr);
21 procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is
22 variable num_result: integer;
23 variable a: mal_seq_ptr;
26 if func_sym.string_val.all = "+" then
27 new_number(a(0).number_val + a(1).number_val, result);
28 elsif func_sym.string_val.all = "-" then
29 new_number(a(0).number_val - a(1).number_val, result);
30 elsif func_sym.string_val.all = "*" then
31 new_number(a(0).number_val * a(1).number_val, result);
32 elsif func_sym.string_val.all = "/" then
33 new_number(a(0).number_val / a(1).number_val, result);
37 end procedure eval_native_func;
39 procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout mal_val_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is
40 variable eval_err: mal_val_ptr;
42 result := new mal_seq(0 to ast_seq'length - 1);
43 for i in result'range loop
44 EVAL(ast_seq(i), env, result(i), eval_err);
45 if eval_err /= null then
50 end procedure eval_ast_seq;
52 procedure eval_ast(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
53 variable key, val, eval_err: mal_val_ptr;
54 variable new_seq: mal_seq_ptr;
59 new_string(ast.string_val, key);
60 hashmap_get(env, key, val);
62 new_string("'" & ast.string_val.all & "' not found", err);
67 when mal_list | mal_vector | mal_hashmap =>
68 eval_ast_seq(ast.seq_val, env, new_seq, eval_err);
69 if eval_err /= null then
73 new_seq_obj(ast.val_type, new_seq, result);
79 end procedure eval_ast;
81 procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
82 variable a, call_args, sub_err: mal_val_ptr;
84 if ast.val_type /= mal_list then
85 eval_ast(ast, env, result, err);
89 if ast.seq_val'length = 0 then
94 eval_ast(ast, env, a, sub_err);
95 if sub_err /= null then
99 seq_drop_prefix(a, 1, call_args);
100 eval_native_func(a.seq_val(0), call_args, result);
103 procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is
105 pr_str(exp, true, result);
106 end procedure mal_PRINT;
108 procedure REP(str: in string; env: inout mal_val_ptr; result: out line; err: out mal_val_ptr) is
109 variable ast, eval_res, read_err, eval_err: mal_val_ptr;
111 mal_READ(str, ast, read_err);
112 if read_err /= null then
121 EVAL(ast, env, eval_res, eval_err);
122 if eval_err /= null then
127 mal_PRINT(eval_res, result);
131 variable is_eof: boolean;
132 variable input_line, result: line;
133 variable repl_seq: mal_seq_ptr;
134 variable repl_env, err: mal_val_ptr;
136 repl_seq := new mal_seq(0 to 7);
137 new_string("+", repl_seq(0));
138 new_nativefn("+", repl_seq(1));
139 new_string("-", repl_seq(2));
140 new_nativefn("-", repl_seq(3));
141 new_string("*", repl_seq(4));
142 new_nativefn("*", repl_seq(5));
143 new_string("/", repl_seq(6));
144 new_nativefn("/", repl_seq(7));
145 new_seq_obj(mal_hashmap, repl_seq, repl_env);
148 mal_readline("user> ", is_eof, input_line);
150 next when input_line'length = 0;
151 REP(input_line.all, repl_env, result, err);
153 pr_str(err, false, result);
154 result := new string'("Error: " & result.all);
156 if result /= null then
157 mal_printline(result.all);
167 end architecture test;