forked from kanaka/mal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
step2_eval.vhdl
167 lines (153 loc) · 4.79 KB
/
step2_eval.vhdl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
entity step2_eval is
end entity step2_eval;
library STD;
use STD.textio.all;
library WORK;
use WORK.pkg_readline.all;
use WORK.types.all;
use WORK.printer.all;
use WORK.reader.all;
architecture test of step2_eval is
procedure mal_READ(str: in string; ast: out mal_val_ptr; err: out mal_val_ptr) is
begin
read_str(str, ast, err);
end procedure mal_READ;
-- Forward declaration
procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr);
procedure eval_native_func(func_sym: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr) is
variable num_result: integer;
variable a: mal_seq_ptr;
begin
a := args.seq_val;
if func_sym.string_val.all = "+" then
new_number(a(0).number_val + a(1).number_val, result);
elsif func_sym.string_val.all = "-" then
new_number(a(0).number_val - a(1).number_val, result);
elsif func_sym.string_val.all = "*" then
new_number(a(0).number_val * a(1).number_val, result);
elsif func_sym.string_val.all = "/" then
new_number(a(0).number_val / a(1).number_val, result);
else
result := null;
end if;
end procedure eval_native_func;
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
variable eval_err: mal_val_ptr;
begin
result := new mal_seq(0 to ast_seq'length - 1);
for i in result'range loop
EVAL(ast_seq(i), env, result(i), eval_err);
if eval_err /= null then
err := eval_err;
return;
end if;
end loop;
end procedure eval_ast_seq;
procedure eval_ast(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
variable key, val, eval_err: mal_val_ptr;
variable new_seq: mal_seq_ptr;
variable i: integer;
begin
case ast.val_type is
when mal_symbol =>
new_string(ast.string_val, key);
hashmap_get(env, key, val);
if val = null then
new_string("'" & ast.string_val.all & "' not found", err);
return;
end if;
result := val;
return;
when mal_list | mal_vector | mal_hashmap =>
eval_ast_seq(ast.seq_val, env, new_seq, eval_err);
if eval_err /= null then
err := eval_err;
return;
end if;
new_seq_obj(ast.val_type, new_seq, result);
return;
when others =>
result := ast;
return;
end case;
end procedure eval_ast;
procedure EVAL(ast: inout mal_val_ptr; env: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is
variable a, call_args, sub_err: mal_val_ptr;
begin
if ast.val_type /= mal_list then
eval_ast(ast, env, result, err);
return;
end if;
if ast.seq_val'length = 0 then
result := ast;
return;
end if;
eval_ast(ast, env, a, sub_err);
if sub_err /= null then
err := sub_err;
return;
end if;
seq_drop_prefix(a, 1, call_args);
eval_native_func(a.seq_val(0), call_args, result);
end procedure EVAL;
procedure mal_PRINT(exp: inout mal_val_ptr; result: out line) is
begin
pr_str(exp, true, result);
end procedure mal_PRINT;
procedure REP(str: in string; env: inout mal_val_ptr; result: out line; err: out mal_val_ptr) is
variable ast, eval_res, read_err, eval_err: mal_val_ptr;
begin
mal_READ(str, ast, read_err);
if read_err /= null then
err := read_err;
result := null;
return;
end if;
if ast = null then
result := null;
return;
end if;
EVAL(ast, env, eval_res, eval_err);
if eval_err /= null then
err := eval_err;
result := null;
return;
end if;
mal_PRINT(eval_res, result);
end procedure REP;
procedure repl is
variable is_eof: boolean;
variable input_line, result: line;
variable repl_seq: mal_seq_ptr;
variable repl_env, err: mal_val_ptr;
begin
repl_seq := new mal_seq(0 to 7);
new_string("+", repl_seq(0));
new_nativefn("+", repl_seq(1));
new_string("-", repl_seq(2));
new_nativefn("-", repl_seq(3));
new_string("*", repl_seq(4));
new_nativefn("*", repl_seq(5));
new_string("/", repl_seq(6));
new_nativefn("/", repl_seq(7));
new_seq_obj(mal_hashmap, repl_seq, repl_env);
loop
mal_readline("user> ", is_eof, input_line);
exit when is_eof;
next when input_line'length = 0;
REP(input_line.all, repl_env, result, err);
if err /= null then
pr_str(err, false, result);
result := new string'("Error: " & result.all);
end if;
if result /= null then
mal_printline(result.all);
end if;
deallocate(result);
deallocate(err);
end loop;
mal_printline("");
end procedure repl;
begin
repl;
end architecture test;