Commit | Line | Data |
---|---|---|
36e91db4 DM |
1 | entity step2_eval is |
2 | end entity step2_eval; | |
3 | ||
4 | library STD; | |
5 | use STD.textio.all; | |
6 | library WORK; | |
7 | use WORK.pkg_readline.all; | |
8 | use WORK.types.all; | |
9 | use WORK.printer.all; | |
10 | use WORK.reader.all; | |
11 | ||
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 | |
14 | begin | |
15 | read_str(str, ast, err); | |
16 | end procedure mal_READ; | |
17 | ||
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); | |
20 | ||
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; | |
24 | begin | |
25 | a := args.seq_val; | |
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); | |
34 | else | |
35 | result := null; | |
36 | end if; | |
37 | end procedure eval_native_func; | |
38 | ||
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; | |
41 | begin | |
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 | |
46 | err := eval_err; | |
47 | return; | |
48 | end if; | |
49 | end loop; | |
50 | end procedure eval_ast_seq; | |
51 | ||
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; | |
55 | variable i: integer; | |
56 | begin | |
57 | case ast.val_type is | |
58 | when mal_symbol => | |
59 | new_string(ast.string_val, key); | |
60 | hashmap_get(env, key, val); | |
61 | if val = null then | |
62 | new_string("'" & ast.string_val.all & "' not found", err); | |
63 | return; | |
64 | end if; | |
65 | result := val; | |
66 | return; | |
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 | |
70 | err := eval_err; | |
71 | return; | |
72 | end if; | |
73 | new_seq_obj(ast.val_type, new_seq, result); | |
74 | return; | |
75 | when others => | |
76 | result := ast; | |
77 | return; | |
78 | end case; | |
79 | end procedure eval_ast; | |
80 | ||
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; | |
83 | begin | |
84 | if ast.val_type /= mal_list then | |
85 | eval_ast(ast, env, result, err); | |
86 | return; | |
87 | end if; | |
88 | ||
89 | if ast.seq_val'length = 0 then | |
90 | result := ast; | |
91 | return; | |
92 | end if; | |
93 | ||
94 | eval_ast(ast, env, a, sub_err); | |
95 | if sub_err /= null then | |
96 | err := sub_err; | |
97 | return; | |
98 | end if; | |
99 | seq_drop_prefix(a, 1, call_args); | |
100 | eval_native_func(a.seq_val(0), call_args, result); | |
101 | end procedure EVAL; | |
102 | ||
103 | procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is | |
104 | begin | |
105 | pr_str(exp, true, result); | |
106 | end procedure mal_PRINT; | |
107 | ||
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; | |
110 | begin | |
111 | mal_READ(str, ast, read_err); | |
112 | if read_err /= null then | |
113 | err := read_err; | |
114 | result := null; | |
115 | return; | |
116 | end if; | |
117 | if ast = null then | |
118 | result := null; | |
119 | return; | |
120 | end if; | |
121 | EVAL(ast, env, eval_res, eval_err); | |
122 | if eval_err /= null then | |
123 | err := eval_err; | |
124 | result := null; | |
125 | return; | |
126 | end if; | |
127 | mal_PRINT(eval_res, result); | |
128 | end procedure REP; | |
129 | ||
130 | procedure repl is | |
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; | |
135 | begin | |
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); | |
146 | ||
147 | loop | |
148 | mal_readline("user> ", is_eof, input_line); | |
149 | exit when is_eof; | |
150 | next when input_line'length = 0; | |
151 | REP(input_line.all, repl_env, result, err); | |
152 | if err /= null then | |
153 | pr_str(err, false, result); | |
154 | result := new string'("Error: " & result.all); | |
155 | end if; | |
156 | if result /= null then | |
157 | mal_printline(result.all); | |
158 | end if; | |
159 | deallocate(result); | |
160 | deallocate(err); | |
161 | end loop; | |
162 | mal_printline(""); | |
163 | end procedure repl; | |
164 | ||
165 | begin | |
166 | repl; | |
167 | end architecture test; |