Commit | Line | Data |
---|---|---|
0fc03918 JM |
1 | @io.sql |
2 | @types.sql | |
3 | @reader.sql | |
4 | @printer.sql | |
5 | @env.sql | |
6 | @core.sql | |
7 | ||
8 | CREATE OR REPLACE PACKAGE mal IS | |
9 | ||
10cc781f | 10 | FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; |
0fc03918 JM |
11 | |
12 | END mal; | |
13 | / | |
14 | ||
15 | CREATE OR REPLACE PACKAGE BODY mal IS | |
16 | ||
10cc781f | 17 | FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS |
2866f9a8 | 18 | M types.mal_table; -- general mal value memory pool |
6a085103 JM |
19 | H types.map_entry_table; -- hashmap memory pool |
20 | E env_pkg.env_entry_table; -- mal env memory pool | |
0fc03918 JM |
21 | repl_env integer; |
22 | x integer; | |
02936b42 | 23 | line CLOB; |
2866f9a8 | 24 | core_ns core_ns_T; |
0fc03918 | 25 | cidx integer; |
2866f9a8 | 26 | argv mal_vals; |
0fc03918 JM |
27 | |
28 | -- read | |
29 | FUNCTION READ(line varchar) RETURN integer IS | |
30 | BEGIN | |
6a085103 | 31 | RETURN reader.read_str(M, H, line); |
0fc03918 JM |
32 | END; |
33 | ||
34 | -- eval | |
35 | ||
36 | -- forward declarations | |
37 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; | |
2866f9a8 | 38 | FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer; |
0fc03918 JM |
39 | |
40 | FUNCTION is_pair(ast integer) RETURN BOOLEAN IS | |
41 | BEGIN | |
42 | RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0; | |
43 | END; | |
44 | ||
45 | FUNCTION quasiquote(ast integer) RETURN integer IS | |
46 | a0 integer; | |
47 | a00 integer; | |
48 | BEGIN | |
49 | IF NOT is_pair(ast) THEN | |
50 | RETURN types.list(M, types.symbol(M, 'quote'), ast); | |
51 | ELSE | |
52 | a0 := types.nth(M, ast, 0); | |
53 | IF M(a0).type_id = 7 AND | |
2866f9a8 | 54 | TREAT(m(a0) AS mal_str_T).val_str = 'unquote' THEN |
0fc03918 JM |
55 | RETURN types.nth(M, ast, 1); |
56 | ELSIF is_pair(a0) THEN | |
57 | a00 := types.nth(M, a0, 0); | |
58 | IF M(a00).type_id = 7 AND | |
2866f9a8 | 59 | TREAT(M(a00) AS mal_str_T).val_str = 'splice-unquote' THEN |
0fc03918 JM |
60 | RETURN types.list(M, types.symbol(M, 'concat'), |
61 | types.nth(M, a0, 1), | |
62 | quasiquote(types.slice(M, ast, 1))); | |
63 | END IF; | |
64 | END IF; | |
65 | RETURN types.list(M, types.symbol(M, 'cons'), | |
66 | quasiquote(a0), | |
67 | quasiquote(types.slice(M, ast, 1))); | |
68 | END IF; | |
69 | END; | |
70 | ||
71 | FUNCTION eval_ast(ast integer, env integer) RETURN integer IS | |
6a085103 | 72 | i integer; |
2866f9a8 JM |
73 | old_seq mal_vals; |
74 | new_seq mal_vals; | |
6a085103 JM |
75 | new_hm integer; |
76 | old_midx integer; | |
77 | new_midx integer; | |
78 | k varchar2(256); | |
0fc03918 JM |
79 | BEGIN |
80 | IF M(ast).type_id = 7 THEN | |
10cc781f | 81 | RETURN env_pkg.env_get(M, E, env, ast); |
0fc03918 | 82 | ELSIF M(ast).type_id IN (8,9) THEN |
2866f9a8 JM |
83 | old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; |
84 | new_seq := mal_vals(); | |
0fc03918 JM |
85 | new_seq.EXTEND(old_seq.COUNT); |
86 | FOR i IN 1..old_seq.COUNT LOOP | |
87 | new_seq(i) := EVAL(old_seq(i), env); | |
88 | END LOOP; | |
89 | RETURN types.seq(M, M(ast).type_id, new_seq); | |
6a085103 | 90 | ELSIF M(ast).type_id IN (10) THEN |
2866f9a8 JM |
91 | new_hm := types.hash_map(M, H, mal_vals()); |
92 | old_midx := TREAT(M(ast) AS mal_map_T).map_idx; | |
93 | new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; | |
6a085103 JM |
94 | |
95 | k := H(old_midx).FIRST(); | |
96 | WHILE k IS NOT NULL LOOP | |
97 | H(new_midx)(k) := EVAL(H(old_midx)(k), env); | |
98 | k := H(old_midx).NEXT(k); | |
99 | END LOOP; | |
100 | RETURN new_hm; | |
0fc03918 JM |
101 | ELSE |
102 | RETURN ast; | |
103 | END IF; | |
104 | END; | |
105 | ||
106 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS | |
107 | ast integer := orig_ast; | |
108 | env integer := orig_env; | |
109 | el integer; | |
110 | a0 integer; | |
150011e4 | 111 | a0sym varchar2(100); |
2866f9a8 | 112 | seq mal_vals; |
0fc03918 JM |
113 | let_env integer; |
114 | i integer; | |
115 | f integer; | |
116 | cond integer; | |
2866f9a8 JM |
117 | malfn mal_func_T; |
118 | args mal_vals; | |
0fc03918 JM |
119 | BEGIN |
120 | WHILE TRUE LOOP | |
2866f9a8 | 121 | -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); |
0fc03918 JM |
122 | IF M(ast).type_id <> 8 THEN |
123 | RETURN eval_ast(ast, env); | |
124 | END IF; | |
6a085103 JM |
125 | IF types.count(M, ast) = 0 THEN |
126 | RETURN ast; -- empty list just returned | |
127 | END IF; | |
0fc03918 JM |
128 | |
129 | -- apply | |
130 | a0 := types.first(M, ast); | |
131 | if M(a0).type_id = 7 THEN -- symbol | |
2866f9a8 | 132 | a0sym := TREAT(M(a0) AS mal_str_T).val_str; |
0fc03918 JM |
133 | ELSE |
134 | a0sym := '__<*fn*>__'; | |
135 | END IF; | |
136 | ||
137 | CASE | |
138 | WHEN a0sym = 'def!' THEN | |
10cc781f | 139 | RETURN env_pkg.env_set(M, E, env, |
0fc03918 JM |
140 | types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); |
141 | WHEN a0sym = 'let*' THEN | |
10cc781f | 142 | let_env := env_pkg.env_new(M, E, env); |
2866f9a8 | 143 | seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; |
0fc03918 JM |
144 | i := 1; |
145 | WHILE i <= seq.COUNT LOOP | |
10cc781f | 146 | x := env_pkg.env_set(M, E, let_env, |
0fc03918 JM |
147 | seq(i), EVAL(seq(i+1), let_env)); |
148 | i := i + 2; | |
149 | END LOOP; | |
150 | env := let_env; | |
151 | ast := types.nth(M, ast, 2); -- TCO | |
152 | WHEN a0sym = 'quote' THEN | |
153 | RETURN types.nth(M, ast, 1); | |
154 | WHEN a0sym = 'quasiquote' THEN | |
155 | RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env); | |
156 | WHEN a0sym = 'do' THEN | |
157 | x := types.slice(M, ast, 1, types.count(M, ast)-2); | |
158 | x := eval_ast(x, env); | |
159 | ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO | |
160 | WHEN a0sym = 'if' THEN | |
161 | cond := EVAL(types.nth(M, ast, 1), env); | |
162 | IF cond = 1 OR cond = 2 THEN -- nil or false | |
163 | IF types.count(M, ast) > 3 THEN | |
6a085103 | 164 | ast := types.nth(M, ast, 3); -- TCO |
0fc03918 JM |
165 | ELSE |
166 | RETURN 1; -- nil | |
167 | END IF; | |
168 | ELSE | |
6a085103 | 169 | ast := types.nth(M, ast, 2); -- TCO |
0fc03918 JM |
170 | END IF; |
171 | WHEN a0sym = 'fn*' THEN | |
172 | RETURN types.malfunc(M, types.nth(M, ast, 2), | |
173 | types.nth(M, ast, 1), | |
174 | env); | |
175 | ELSE | |
176 | el := eval_ast(ast, env); | |
177 | f := types.first(M, el); | |
2866f9a8 | 178 | args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; |
0fc03918 | 179 | IF M(f).type_id = 12 THEN |
2866f9a8 | 180 | malfn := TREAT(M(f) AS mal_func_T); |
10cc781f | 181 | env := env_pkg.env_new(M, E, malfn.env, |
0fc03918 JM |
182 | malfn.params, args); |
183 | ast := malfn.ast; -- TCO | |
184 | ELSE | |
185 | RETURN do_builtin(f, args); | |
186 | END IF; | |
187 | END CASE; | |
188 | ||
189 | END LOOP; | |
190 | ||
191 | END; | |
192 | ||
193 | -- hack to get around lack of function references | |
194 | -- functions that require special access to repl_env or EVAL | |
195 | -- are implemented directly here, otherwise, core.do_core_fn | |
196 | -- is called. | |
2866f9a8 | 197 | FUNCTION do_builtin(fn integer, args mal_vals) RETURN integer IS |
0fc03918 | 198 | fname varchar2(100); |
150011e4 | 199 | val integer; |
0fc03918 | 200 | f integer; |
2866f9a8 JM |
201 | malfn mal_func_T; |
202 | fargs mal_vals; | |
0fc03918 JM |
203 | fn_env integer; |
204 | BEGIN | |
2866f9a8 | 205 | fname := TREAT(M(fn) AS mal_str_T).val_str; |
0fc03918 JM |
206 | CASE |
207 | WHEN fname = 'do_eval' THEN | |
150011e4 | 208 | RETURN EVAL(args(1), repl_env); |
0fc03918 | 209 | WHEN fname = 'swap!' THEN |
2866f9a8 | 210 | val := TREAT(M(args(1)) AS mal_atom_T).val; |
150011e4 | 211 | f := args(2); |
0fc03918 JM |
212 | -- slice one extra at the beginning that will be changed |
213 | -- to the value of the atom | |
2866f9a8 | 214 | fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_T).val_seq; |
150011e4 | 215 | fargs(1) := val; |
0fc03918 | 216 | IF M(f).type_id = 12 THEN |
2866f9a8 | 217 | malfn := TREAT(M(f) AS mal_func_T); |
10cc781f | 218 | fn_env := env_pkg.env_new(M, E, malfn.env, |
150011e4 JM |
219 | malfn.params, fargs); |
220 | val := EVAL(malfn.ast, fn_env); | |
0fc03918 | 221 | ELSE |
150011e4 | 222 | val := do_builtin(f, fargs); |
0fc03918 | 223 | END IF; |
2866f9a8 | 224 | RETURN types.atom_reset(M, args(1), val); |
0fc03918 | 225 | ELSE |
6a085103 | 226 | RETURN core.do_core_func(M, H, fn, args); |
0fc03918 JM |
227 | END CASE; |
228 | END; | |
229 | ||
230 | ||
231 | ||
232 | FUNCTION PRINT(exp integer) RETURN varchar IS | |
233 | BEGIN | |
6a085103 | 234 | RETURN printer.pr_str(M, H, exp); |
0fc03918 JM |
235 | END; |
236 | ||
237 | -- repl | |
238 | FUNCTION REP(line varchar) RETURN varchar IS | |
239 | BEGIN | |
240 | RETURN PRINT(EVAL(READ(line), repl_env)); | |
241 | END; | |
242 | ||
243 | BEGIN | |
6a085103 | 244 | -- initialize memory pools |
0fc03918 | 245 | M := types.mem_new(); |
6a085103 | 246 | H := types.map_entry_table(); |
10cc781f | 247 | E := env_pkg.env_entry_table(); |
0fc03918 | 248 | |
10cc781f JM |
249 | repl_env := env_pkg.env_new(M, E, NULL); |
250 | ||
2866f9a8 | 251 | argv := TREAT(M(reader.read_str(M, H, args)) AS mal_seq_T).val_seq; |
0fc03918 JM |
252 | |
253 | -- core.EXT: defined using PL/SQL | |
254 | core_ns := core.get_core_ns(); | |
255 | FOR cidx IN 1..core_ns.COUNT LOOP | |
10cc781f | 256 | x := env_pkg.env_set(M, E, repl_env, |
0fc03918 JM |
257 | types.symbol(M, core_ns(cidx)), |
258 | types.func(M, core_ns(cidx))); | |
259 | END LOOP; | |
10cc781f | 260 | x := env_pkg.env_set(M, E, repl_env, |
0fc03918 JM |
261 | types.symbol(M, 'eval'), |
262 | types.func(M, 'do_eval')); | |
10cc781f | 263 | x := env_pkg.env_set(M, E, repl_env, |
0fc03918 | 264 | types.symbol(M, '*ARGV*'), |
10cc781f | 265 | types.slice(M, argv, 1)); |
0fc03918 JM |
266 | |
267 | -- core.mal: defined using the language itself | |
268 | line := REP('(def! not (fn* (a) (if a false true)))'); | |
269 | line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))'); | |
270 | ||
10cc781f | 271 | IF argv.COUNT() > 0 THEN |
8119e744 JM |
272 | BEGIN |
273 | line := REP('(load-file "' || | |
2866f9a8 | 274 | TREAT(M(argv(1)) AS mal_str_T).val_str || |
8119e744 JM |
275 | '")'); |
276 | io.close(1); -- close output stream | |
277 | RETURN 0; | |
278 | EXCEPTION WHEN OTHERS THEN | |
279 | io.writeline('Error: ' || SQLERRM); | |
280 | io.writeline(dbms_utility.format_error_backtrace); | |
281 | io.close(1); -- close output stream | |
282 | RAISE; | |
283 | END; | |
10cc781f JM |
284 | END IF; |
285 | ||
0fc03918 JM |
286 | WHILE true LOOP |
287 | BEGIN | |
02936b42 JM |
288 | line := io.readline('user> ', 0); |
289 | IF line = EMPTY_CLOB() THEN CONTINUE; END IF; | |
0fc03918 | 290 | IF line IS NOT NULL THEN |
02936b42 | 291 | io.writeline(REP(line)); |
0fc03918 JM |
292 | END IF; |
293 | ||
294 | EXCEPTION WHEN OTHERS THEN | |
8119e744 JM |
295 | IF SQLCODE = -20001 THEN -- io read stream closed |
296 | io.close(1); -- close output stream | |
0fc03918 JM |
297 | RETURN 0; |
298 | END IF; | |
02936b42 JM |
299 | io.writeline('Error: ' || SQLERRM); |
300 | io.writeline(dbms_utility.format_error_backtrace); | |
0fc03918 JM |
301 | END; |
302 | END LOOP; | |
303 | END; | |
304 | ||
305 | END mal; | |
306 | / | |
307 | show errors; | |
308 | ||
309 | quit; |