Commit | Line | Data |
---|---|---|
8c7587af MK |
1 | @include "types.awk" |
2 | @include "reader.awk" | |
3 | @include "printer.awk" | |
4 | ||
5 | function READ(str) | |
6 | { | |
7 | return reader_read_str(str) | |
8 | } | |
9 | ||
10 | function eval_ast(ast, env, i, idx, len, new_idx, ret) | |
11 | { | |
12 | switch (ast) { | |
13 | case /^'/: | |
14 | if (ast in env) { | |
15 | return types_addref(env[ast]) | |
16 | } | |
17 | return "!\"'" substr(ast, 2) "' not found" | |
18 | case /^[([]/: | |
19 | idx = substr(ast, 2) | |
20 | len = types_heap[idx]["len"] | |
21 | new_idx = types_allocate() | |
22 | for (i = 0; i < len; ++i) { | |
23 | ret = EVAL(types_addref(types_heap[idx][i]), env) | |
24 | if (ret ~ /^!/) { | |
25 | types_heap[new_idx]["len"] = i | |
26 | types_release(substr(ast, 1, 1) new_idx) | |
27 | return ret | |
28 | } | |
29 | types_heap[new_idx][i] = ret | |
30 | } | |
31 | types_heap[new_idx]["len"] = len | |
32 | return substr(ast, 1, 1) new_idx | |
33 | case /^\{/: | |
34 | idx = substr(ast, 2) | |
35 | new_idx = types_allocate() | |
36 | for (i in types_heap[idx]) { | |
37 | if (i ~ /^[":]/) { | |
38 | ret = EVAL(types_addref(types_heap[idx][i]), env) | |
39 | if (ret ~ /^!/) { | |
40 | types_release("{" new_idx) | |
41 | return ret | |
42 | } | |
43 | types_heap[new_idx][i] = ret | |
44 | } | |
45 | } | |
46 | return "{" new_idx | |
47 | default: | |
48 | return ast | |
49 | } | |
50 | } | |
51 | ||
52 | function EVAL(ast, env, new_ast, ret, idx, f, f_idx) | |
53 | { | |
54 | if (ast !~ /^\(/) { | |
55 | ret = eval_ast(ast, env) | |
56 | types_release(ast) | |
57 | return ret | |
58 | } | |
59 | idx = substr(ast, 2) | |
60 | if (types_heap[idx]["len"] == 0) { | |
61 | return ast | |
62 | } | |
63 | new_ast = eval_ast(ast, env) | |
64 | types_release(ast) | |
65 | if (new_ast ~ /^!/) { | |
66 | return new_ast | |
67 | } | |
68 | idx = substr(new_ast, 2) | |
69 | f = types_heap[idx][0] | |
70 | if (f ~ /^&/) { | |
71 | f_idx = substr(f, 2) | |
72 | ret = @f_idx(idx) | |
73 | types_release(new_ast) | |
74 | return ret | |
75 | } else { | |
76 | types_release(new_ast) | |
77 | return "!\"First element of list must be function, supplied " types_typename(f) "." | |
78 | } | |
79 | } | |
80 | ||
81 | function PRINT(expr, str) | |
82 | { | |
83 | str = printer_pr_str(expr, 1) | |
84 | types_release(expr) | |
85 | return str | |
86 | } | |
87 | ||
88 | function rep(str, ast, expr) | |
89 | { | |
90 | ast = READ(str) | |
91 | if (ast ~ /^!/) { | |
92 | return ast | |
93 | } | |
94 | expr = EVAL(ast, repl_env) | |
95 | if (expr ~ /^!/) { | |
96 | return expr | |
97 | } | |
98 | return PRINT(expr) | |
99 | } | |
100 | ||
101 | function add(idx, lhs, rhs) | |
102 | { | |
103 | if (types_heap[idx]["len"] != 3) { | |
104 | return "!\"Invalid argument length for builtin function '+'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." | |
105 | } | |
106 | lhs = types_heap[idx][1] | |
107 | if (lhs !~ /^\+/) { | |
108 | return "!\"Incompatible type for argument 1 of builtin function '+'. Expects number, supplied " types_typename(lhs) "." | |
109 | } | |
110 | rhs = types_heap[idx][2] | |
111 | if (rhs !~ /^\+/) { | |
112 | return "!\"Incompatible type for argument 2 of builtin function '+'. Expects number, supplied " types_typename(rhs) "." | |
113 | } | |
114 | return "+" (substr(lhs, 2) + substr(rhs, 2)) | |
115 | } | |
116 | ||
117 | function subtract(idx, lhs, rhs) | |
118 | { | |
119 | if (types_heap[idx]["len"] != 3) { | |
120 | return "!\"Invalid argument length for builtin function '-'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." | |
121 | } | |
122 | lhs = types_heap[idx][1] | |
123 | if (lhs !~ /^\+/) { | |
124 | return "!\"Incompatible type for argument 1 of builtin function '-'. Expects number, supplied " types_typename(lhs) "." | |
125 | } | |
126 | rhs = types_heap[idx][2] | |
127 | if (rhs !~ /^\+/) { | |
128 | return "!\"Incompatible type for argument 2 of builtin function '-'. Expects number, supplied " types_typename(rhs) "." | |
129 | } | |
130 | return "+" (substr(lhs, 2) - substr(rhs, 2)) | |
131 | } | |
132 | ||
133 | function multiply(idx, lhs, rhs) | |
134 | { | |
135 | if (types_heap[idx]["len"] != 3) { | |
136 | return "!\"Invalid argument length for builtin function '*'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." | |
137 | } | |
138 | lhs = types_heap[idx][1] | |
139 | if (lhs !~ /^\+/) { | |
140 | return "!\"Incompatible type for argument 1 of builtin function '*'. Expects number, supplied " types_typename(lhs) "." | |
141 | } | |
142 | rhs = types_heap[idx][2] | |
143 | if (rhs !~ /^\+/) { | |
144 | return "!\"Incompatible type for argument 2 of builtin function '*'. Expects number, supplied " types_typename(rhs) "." | |
145 | } | |
146 | return "+" (substr(lhs, 2) * substr(rhs, 2)) | |
147 | } | |
148 | ||
149 | function divide(idx, lhs, rhs) | |
150 | { | |
151 | if (types_heap[idx]["len"] != 3) { | |
152 | return "!\"Invalid argument length for builtin function '/'. Expects exactly 2 arguments, supplied " (types_heap[idx]["len"] - 1) "." | |
153 | } | |
154 | lhs = types_heap[idx][1] | |
155 | if (lhs !~ /^\+/) { | |
156 | return "!\"Incompatible type for argument 1 of builtin function '/'. Expects number, supplied " types_typename(lhs) "." | |
157 | } | |
158 | rhs = types_heap[idx][2] | |
159 | if (rhs !~ /^\+/) { | |
160 | return "!\"Incompatible type for argument 2 of builtin function '/'. Expects number, supplied " types_typename(rhs) "." | |
161 | } | |
162 | return "+" int(substr(lhs, 2) / substr(rhs, 2)) | |
163 | } | |
164 | ||
165 | function main(str, ret) | |
166 | { | |
167 | repl_env["'+"] = "&add" | |
168 | repl_env["'-"] = "&subtract" | |
169 | repl_env["'*"] = "&multiply" | |
170 | repl_env["'/"] = "÷" | |
171 | env_builtinnames["add"] = "+" | |
172 | env_builtinnames["subtract"] = "-" | |
173 | env_builtinnames["multiply"] = "*" | |
174 | env_builtinnames["divide"] = "/" | |
175 | ||
176 | while (1) { | |
177 | printf("user> ") | |
178 | if (getline str <= 0) { | |
179 | break | |
180 | } | |
181 | ret = rep(str) | |
182 | if (ret ~ /^!/) { | |
183 | print "ERROR: " printer_pr_str(substr(ret, 2)) | |
184 | } else { | |
185 | print ret | |
186 | } | |
187 | } | |
188 | } | |
189 | ||
190 | BEGIN { | |
191 | main() | |
192 | exit(0) | |
193 | } |