Commit | Line | Data |
---|---|---|
494792ab JM |
1 | -- --------------------------------------------------------- |
2 | -- step9_try.sql | |
3 | ||
b29f08ad | 4 | \i init.sql |
53105a77 | 5 | \i io.sql |
b29f08ad JM |
6 | \i types.sql |
7 | \i reader.sql | |
8 | \i printer.sql | |
494792ab | 9 | \i envs.sql |
b29f08ad JM |
10 | \i core.sql |
11 | ||
12 | -- --------------------------------------------------------- | |
494792ab JM |
13 | |
14 | CREATE SCHEMA mal; | |
b29f08ad JM |
15 | |
16 | -- read | |
494792ab | 17 | CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ |
b29f08ad | 18 | BEGIN |
494792ab | 19 | RETURN reader.read_str(line); |
b29f08ad JM |
20 | END; $$ LANGUAGE plpgsql; |
21 | ||
22 | -- eval | |
494792ab | 23 | CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$ |
b29f08ad | 24 | BEGIN |
494792ab | 25 | RETURN types._sequential_Q(ast) AND types._count(ast) > 0; |
b29f08ad JM |
26 | END; $$ LANGUAGE plpgsql; |
27 | ||
494792ab | 28 | CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$ |
b29f08ad JM |
29 | DECLARE |
30 | a0 integer; | |
31 | a00 integer; | |
32 | BEGIN | |
494792ab JM |
33 | IF NOT mal.is_pair(ast) THEN |
34 | RETURN types._list(ARRAY[types._symbolv('quote'), ast]); | |
b29f08ad | 35 | ELSE |
494792ab JM |
36 | a0 := types._nth(ast, 0); |
37 | IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN | |
38 | RETURN types._nth(ast, 1); | |
b29f08ad | 39 | ELSE |
494792ab JM |
40 | a00 := types._nth(a0, 0); |
41 | IF types._symbol_Q(a00) AND | |
42 | a00 = types._symbolv('splice-unquote') THEN | |
43 | RETURN types._list(ARRAY[types._symbolv('concat'), | |
44 | types._nth(a0, 1), | |
45 | mal.quasiquote(types._rest(ast))]); | |
b29f08ad JM |
46 | END IF; |
47 | END IF; | |
494792ab JM |
48 | RETURN types._list(ARRAY[types._symbolv('cons'), |
49 | mal.quasiquote(types._first(ast)), | |
50 | mal.quasiquote(types._rest(ast))]); | |
b29f08ad JM |
51 | END IF; |
52 | END; $$ LANGUAGE plpgsql; | |
53 | ||
494792ab | 54 | CREATE FUNCTION mal.is_macro_call(ast integer, env integer) RETURNS boolean AS $$ |
b29f08ad JM |
55 | DECLARE |
56 | a0 integer; | |
57 | f integer; | |
58 | result boolean = false; | |
59 | BEGIN | |
494792ab JM |
60 | IF types._list_Q(ast) THEN |
61 | a0 = types._first(ast); | |
62 | IF types._symbol_Q(a0) AND | |
63 | envs.find(env, types._valueToString(a0)) IS NOT NULL THEN | |
64 | f := envs.get(env, a0); | |
65 | SELECT macro INTO result FROM types.value WHERE value_id = f; | |
b29f08ad JM |
66 | END IF; |
67 | END IF; | |
68 | RETURN result; | |
69 | END; $$ LANGUAGE plpgsql; | |
70 | ||
494792ab | 71 | CREATE FUNCTION mal.macroexpand(ast integer, env integer) RETURNS integer AS $$ |
b29f08ad JM |
72 | DECLARE |
73 | mac integer; | |
74 | BEGIN | |
494792ab | 75 | WHILE mal.is_macro_call(ast, env) |
b29f08ad | 76 | LOOP |
494792ab JM |
77 | mac := envs.get(env, types._first(ast)); |
78 | ast := types._apply(mac, types._valueToArray(types._rest(ast))); | |
b29f08ad JM |
79 | END LOOP; |
80 | RETURN ast; | |
81 | END; $$ LANGUAGE plpgsql; | |
82 | ||
494792ab | 83 | CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ |
b29f08ad JM |
84 | DECLARE |
85 | type integer; | |
b642c0db JM |
86 | seq integer[]; |
87 | eseq integer[]; | |
88 | hash hstore; | |
89 | ehash hstore; | |
90 | kv RECORD; | |
b29f08ad JM |
91 | e integer; |
92 | result integer; | |
93 | BEGIN | |
494792ab | 94 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; |
b29f08ad JM |
95 | CASE |
96 | WHEN type = 7 THEN | |
97 | BEGIN | |
494792ab | 98 | result := envs.get(env, ast); |
b29f08ad | 99 | END; |
b642c0db | 100 | WHEN type IN (8, 9) THEN |
b29f08ad | 101 | BEGIN |
494792ab | 102 | SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; |
b642c0db JM |
103 | -- Evaluate each entry creating a new sequence |
104 | FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP | |
494792ab | 105 | eseq[i] := mal.EVAL(seq[i], env); |
b642c0db | 106 | END LOOP; |
494792ab | 107 | INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq) |
97c0256d | 108 | RETURNING value_id INTO result; |
b642c0db JM |
109 | END; |
110 | WHEN type = 10 THEN | |
111 | BEGIN | |
494792ab | 112 | SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; |
b642c0db JM |
113 | -- Evaluate each value for every key/value |
114 | FOR kv IN SELECT * FROM each(hash) LOOP | |
494792ab | 115 | e := mal.EVAL(CAST(kv.value AS integer), env); |
b642c0db JM |
116 | IF ehash IS NULL THEN |
117 | ehash := hstore(kv.key, CAST(e AS varchar)); | |
118 | ELSE | |
119 | ehash := ehash || hstore(kv.key, CAST(e AS varchar)); | |
120 | END IF; | |
b29f08ad | 121 | END LOOP; |
494792ab | 122 | INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash) |
b642c0db | 123 | RETURNING value_id INTO result; |
b29f08ad JM |
124 | END; |
125 | ELSE | |
126 | result := ast; | |
127 | END CASE; | |
128 | ||
129 | RETURN result; | |
130 | END; $$ LANGUAGE plpgsql; | |
131 | ||
494792ab | 132 | CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ |
b29f08ad JM |
133 | DECLARE |
134 | type integer; | |
135 | a0 integer; | |
136 | a0sym varchar; | |
137 | a1 integer; | |
138 | a2 integer; | |
139 | let_env integer; | |
b642c0db | 140 | idx integer; |
b29f08ad JM |
141 | binds integer[]; |
142 | exprs integer[]; | |
143 | el integer; | |
144 | fn integer; | |
145 | fname varchar; | |
146 | args integer[]; | |
147 | cond integer; | |
148 | fast integer; | |
149 | fparams integer; | |
150 | fenv integer; | |
151 | result integer; | |
152 | BEGIN | |
153 | LOOP | |
494792ab JM |
154 | -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); |
155 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; | |
b29f08ad | 156 | IF type <> 8 THEN |
494792ab | 157 | RETURN mal.eval_ast(ast, env); |
b29f08ad JM |
158 | END IF; |
159 | ||
494792ab JM |
160 | ast := mal.macroexpand(ast, env); |
161 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; | |
b29f08ad | 162 | IF type <> 8 THEN |
494792ab JM |
163 | RETURN mal.eval_ast(ast, env); |
164 | END IF; | |
165 | IF types._count(ast) = 0 THEN | |
166 | RETURN ast; | |
b29f08ad JM |
167 | END IF; |
168 | ||
494792ab JM |
169 | a0 := types._first(ast); |
170 | IF types._symbol_Q(a0) THEN | |
171 | a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); | |
b29f08ad JM |
172 | ELSE |
173 | a0sym := '__<*fn*>__'; | |
174 | END IF; | |
175 | ||
b29f08ad JM |
176 | CASE |
177 | WHEN a0sym = 'def!' THEN | |
178 | BEGIN | |
494792ab JM |
179 | RETURN envs.set(env, types._nth(ast, 1), |
180 | mal.EVAL(types._nth(ast, 2), env)); | |
b29f08ad JM |
181 | END; |
182 | WHEN a0sym = 'let*' THEN | |
183 | BEGIN | |
494792ab JM |
184 | let_env := envs.new(env); |
185 | a1 := types._nth(ast, 1); | |
186 | binds := (SELECT val_seq FROM types.value WHERE value_id = a1); | |
b642c0db JM |
187 | idx := 1; |
188 | WHILE idx < array_length(binds, 1) LOOP | |
494792ab JM |
189 | PERFORM envs.set(let_env, binds[idx], |
190 | mal.EVAL(binds[idx+1], let_env)); | |
b642c0db | 191 | idx := idx + 2; |
b29f08ad JM |
192 | END LOOP; |
193 | env := let_env; | |
494792ab | 194 | ast := types._nth(ast, 2); |
b29f08ad JM |
195 | CONTINUE; -- TCO |
196 | END; | |
197 | WHEN a0sym = 'quote' THEN | |
198 | BEGIN | |
494792ab | 199 | RETURN types._nth(ast, 1); |
b29f08ad JM |
200 | END; |
201 | WHEN a0sym = 'quasiquote' THEN | |
202 | BEGIN | |
494792ab | 203 | ast := mal.quasiquote(types._nth(ast, 1)); |
b29f08ad JM |
204 | CONTINUE; -- TCO |
205 | END; | |
206 | WHEN a0sym = 'defmacro!' THEN | |
207 | BEGIN | |
494792ab JM |
208 | fn := mal.EVAL(types._nth(ast, 2), env); |
209 | fn := types._macro(fn); | |
210 | RETURN envs.set(env, types._nth(ast, 1), fn); | |
b29f08ad JM |
211 | END; |
212 | WHEN a0sym = 'macroexpand' THEN | |
213 | BEGIN | |
494792ab | 214 | RETURN mal.macroexpand(types._nth(ast, 1), env); |
b29f08ad JM |
215 | END; |
216 | WHEN a0sym = 'try*' THEN | |
217 | BEGIN | |
218 | BEGIN | |
494792ab | 219 | RETURN mal.EVAL(types._nth(ast, 1), env); |
b29f08ad | 220 | EXCEPTION WHEN OTHERS THEN |
494792ab JM |
221 | IF types._count(ast) >= 3 THEN |
222 | a2 = types._nth(ast, 2); | |
223 | IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN | |
224 | binds := ARRAY[types._nth(a2, 1)]; | |
225 | exprs := ARRAY[types._stringv(SQLERRM)]; | |
226 | env := envs.new(env, types._list(binds), exprs); | |
227 | RETURN mal.EVAL(types._nth(a2, 2), env); | |
b29f08ad JM |
228 | END IF; |
229 | END IF; | |
230 | RAISE; | |
231 | END; | |
232 | END; | |
233 | WHEN a0sym = 'do' THEN | |
234 | BEGIN | |
494792ab JM |
235 | PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); |
236 | ast := types._nth(ast, types._count(ast)-1); | |
b29f08ad JM |
237 | CONTINUE; -- TCO |
238 | END; | |
239 | WHEN a0sym = 'if' THEN | |
240 | BEGIN | |
494792ab JM |
241 | cond := mal.EVAL(types._nth(ast, 1), env); |
242 | SELECT type_id INTO type FROM types.value WHERE value_id = cond; | |
b29f08ad | 243 | IF type = 0 OR type = 1 THEN -- nil or false |
494792ab JM |
244 | IF types._count(ast) > 3 THEN |
245 | ast := types._nth(ast, 3); | |
b29f08ad JM |
246 | CONTINUE; -- TCO |
247 | ELSE | |
248 | RETURN 0; -- nil | |
249 | END IF; | |
250 | ELSE | |
494792ab | 251 | ast := types._nth(ast, 2); |
b29f08ad JM |
252 | CONTINUE; -- TCO |
253 | END IF; | |
254 | END; | |
255 | WHEN a0sym = 'fn*' THEN | |
256 | BEGIN | |
494792ab | 257 | RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); |
b29f08ad JM |
258 | END; |
259 | ELSE | |
260 | BEGIN | |
494792ab | 261 | el := mal.eval_ast(ast, env); |
4facce82 | 262 | SELECT type_id, val_string, ast_id, params_id, env_id |
b642c0db | 263 | INTO type, fname, fast, fparams, fenv |
494792ab JM |
264 | FROM types.value WHERE value_id = types._first(el); |
265 | args := types._restArray(el); | |
b29f08ad JM |
266 | IF type = 11 THEN |
267 | EXECUTE format('SELECT %s($1);', fname) | |
268 | INTO result USING args; | |
269 | RETURN result; | |
270 | ELSIF type = 12 THEN | |
494792ab | 271 | env := envs.new(fenv, fparams, args); |
b29f08ad JM |
272 | ast := fast; |
273 | CONTINUE; -- TCO | |
274 | ELSE | |
275 | RAISE EXCEPTION 'Invalid function call'; | |
276 | END IF; | |
277 | END; | |
278 | END CASE; | |
279 | END LOOP; | |
280 | END; $$ LANGUAGE plpgsql; | |
281 | ||
282 | ||
494792ab | 283 | CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ |
b29f08ad | 284 | BEGIN |
494792ab | 285 | RETURN printer.pr_str(exp); |
b29f08ad JM |
286 | END; $$ LANGUAGE plpgsql; |
287 | ||
288 | ||
289 | -- repl | |
290 | ||
291 | -- repl_env is environment 0 | |
292 | ||
494792ab | 293 | CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ |
b29f08ad | 294 | BEGIN |
494792ab | 295 | RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); |
b29f08ad JM |
296 | END; $$ LANGUAGE plpgsql; |
297 | ||
298 | -- core.sql: defined using SQL (in core.sql) | |
299 | -- repl_env is created and populated with core functions in by core.sql | |
494792ab | 300 | CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ |
b29f08ad | 301 | BEGIN |
494792ab | 302 | RETURN mal.EVAL(args[1], 0); |
b29f08ad | 303 | END; $$ LANGUAGE plpgsql; |
494792ab | 304 | INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); |
b29f08ad | 305 | |
494792ab JM |
306 | SELECT envs.vset(0, 'eval', |
307 | (SELECT value_id FROM types.value | |
308 | WHERE val_string = 'mal.mal_eval')) \g '/dev/null' | |
b29f08ad | 309 | -- *ARGV* values are set by RUN |
494792ab | 310 | SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' |
b29f08ad JM |
311 | |
312 | ||
313 | -- core.mal: defined using the language itself | |
494792ab | 314 | SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' |
e6d41de4 | 315 | SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' |
494792ab | 316 | SELECT mal.REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null' |
b29f08ad | 317 | |
494792ab JM |
318 | CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) |
319 | RETURNS integer AS $$ | |
53105a77 | 320 | DECLARE |
494792ab JM |
321 | line varchar; |
322 | output varchar; | |
323 | allargs integer; | |
53105a77 | 324 | BEGIN |
494792ab JM |
325 | PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); |
326 | ||
327 | IF argstring IS NOT NULL THEN | |
328 | allargs := mal.READ(argstring); | |
329 | PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); | |
330 | PERFORM mal.REP('(load-file ' || | |
331 | printer.pr_str(types._first(allargs)) || ')'); | |
332 | PERFORM io.close(1); | |
333 | PERFORM io.wait_flushed(1); | |
334 | RETURN 0; | |
335 | END IF; | |
336 | ||
53105a77 JM |
337 | WHILE true |
338 | LOOP | |
339 | BEGIN | |
494792ab JM |
340 | line := io.readline('user> ', 0); |
341 | IF line IS NULL THEN | |
342 | PERFORM io.close(1); | |
343 | RETURN 0; | |
344 | END IF; | |
345 | IF line NOT IN ('', E'\n') THEN | |
346 | output := mal.REP(line); | |
347 | PERFORM io.writeline(output); | |
53105a77 JM |
348 | END IF; |
349 | ||
350 | EXCEPTION WHEN OTHERS THEN | |
494792ab | 351 | PERFORM io.writeline('Error: ' || SQLERRM); |
53105a77 JM |
352 | END; |
353 | END LOOP; | |
354 | END; $$ LANGUAGE plpgsql; |