1 -- ---------------------------------------------------------
12 -- ---------------------------------------------------------
17 CREATE FUNCTION mal.
READ(line
varchar) RETURNS integer AS $$
19 RETURN reader.
read_str(line
);
20 END; $$
LANGUAGE plpgsql
;
23 CREATE FUNCTION mal.
is_pair(ast
integer) RETURNS boolean AS $$
25 RETURN types.
_sequential_Q(ast
) AND types.
_count(ast
) > 0;
26 END; $$
LANGUAGE plpgsql
;
28 CREATE FUNCTION mal.
quasiquote(ast
integer) RETURNS integer AS $$
33 IF NOT mal.
is_pair(ast
) THEN
34 RETURN types.
_list(ARRAY[types.
_symbolv('quote'), ast
]);
36 a0
:= types.
_nth(ast
, 0);
37 IF types.
_symbol_Q(a0
) AND a0
= types.
_symbolv('unquote') THEN
38 RETURN types.
_nth(ast
, 1);
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'),
45 mal.
quasiquote(types.
_rest(ast
))]);
48 RETURN types.
_list(ARRAY[types.
_symbolv('cons'),
49 mal.
quasiquote(types.
_first(ast
)),
50 mal.
quasiquote(types.
_rest(ast
))]);
52 END; $$
LANGUAGE plpgsql
;
54 CREATE FUNCTION mal.
is_macro_call(ast
integer, env
integer) RETURNS boolean AS $$
58 result boolean = false;
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
;
69 END; $$
LANGUAGE plpgsql
;
71 CREATE FUNCTION mal.
macroexpand(ast
integer, env
integer) RETURNS integer AS $$
75 WHILE mal.
is_macro_call(ast
, env
)
77 mac
:= envs.
get(env
, types.
_first(ast
));
78 ast
:= types.
_apply(mac
, types.
_valueToArray(types.
_rest(ast
)));
81 END; $$
LANGUAGE plpgsql
;
83 CREATE FUNCTION mal.
eval_ast(ast
integer, env
integer) RETURNS integer AS $$
94 SELECT type_id
INTO type FROM types.
value WHERE value_id
= ast
;
98 result := envs.
get(env
, ast
);
100 WHEN type IN (8, 9) THEN
102 SELECT val_seq
INTO seq
FROM types.
value WHERE value_id
= ast
;
103 -- Evaluate each entry creating a new sequence
104 FOR i
IN 1 ..
COALESCE(array_length(seq
, 1), 0) LOOP
105 eseq
[i
] := mal.
EVAL(seq
[i
], env
);
107 INSERT INTO types.
value (type_id
, val_seq
) VALUES (type, eseq
)
108 RETURNING value_id
INTO result;
112 SELECT val_hash
INTO hash
FROM types.
value WHERE value_id
= ast
;
113 -- Evaluate each value for every key/value
114 FOR kv
IN SELECT * FROM each(hash
) LOOP
115 e
:= mal.
EVAL(CAST(kv.
value AS integer), env
);
116 IF ehash
IS NULL THEN
117 ehash
:= hstore(kv.
key, CAST(e
AS varchar));
119 ehash
:= ehash ||
hstore(kv.
key, CAST(e
AS varchar));
122 INSERT INTO types.
value (type_id
, val_hash
) VALUES (type, ehash
)
123 RETURNING value_id
INTO result;
130 END; $$
LANGUAGE plpgsql
;
132 CREATE FUNCTION mal.
EVAL(ast
integer, env
integer) RETURNS integer AS $$
154 -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast));
155 SELECT type_id
INTO type FROM types.
value WHERE value_id
= ast
;
157 RETURN mal.
eval_ast(ast
, env
);
160 ast
:= mal.
macroexpand(ast
, env
);
161 SELECT type_id
INTO type FROM types.
value WHERE value_id
= ast
;
163 RETURN mal.
eval_ast(ast
, env
);
165 IF types.
_count(ast
) = 0 THEN
169 a0
:= types.
_first(ast
);
170 IF types.
_symbol_Q(a0
) THEN
171 a0sym
:= (SELECT val_string
FROM types.
value WHERE value_id
= a0
);
173 a0sym
:= '__<*fn*>__';
177 WHEN a0sym
= 'def!' THEN
179 RETURN envs.
set(env
, types.
_nth(ast
, 1),
180 mal.
EVAL(types.
_nth(ast
, 2), env
));
182 WHEN a0sym
= 'let*' THEN
184 let_env
:= envs.
new(env
);
185 a1
:= types.
_nth(ast
, 1);
186 binds
:= (SELECT val_seq
FROM types.
value WHERE value_id
= a1
);
188 WHILE idx
< array_length(binds
, 1) LOOP
189 PERFORM envs.
set(let_env
, binds
[idx
],
190 mal.
EVAL(binds
[idx
+1], let_env
));
194 ast
:= types.
_nth(ast
, 2);
197 WHEN a0sym
= 'quote' THEN
199 RETURN types.
_nth(ast
, 1);
201 WHEN a0sym
= 'quasiquote' THEN
203 ast
:= mal.
quasiquote(types.
_nth(ast
, 1));
206 WHEN a0sym
= 'defmacro!' THEN
208 fn
:= mal.
EVAL(types.
_nth(ast
, 2), env
);
209 fn
:= types.
_macro(fn
);
210 RETURN envs.
set(env
, types.
_nth(ast
, 1), fn
);
212 WHEN a0sym
= 'macroexpand' THEN
214 RETURN mal.
macroexpand(types.
_nth(ast
, 1), env
);
216 WHEN a0sym
= 'try*' THEN
219 RETURN mal.
EVAL(types.
_nth(ast
, 1), env
);
220 EXCEPTION WHEN OTHERS THEN
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
);
233 WHEN a0sym
= 'do' THEN
235 PERFORM mal.
eval_ast(types.
_slice(ast
, 1, types.
_count(ast
)-1), env
);
236 ast
:= types.
_nth(ast
, types.
_count(ast
)-1);
239 WHEN a0sym
= 'if' THEN
241 cond
:= mal.
EVAL(types.
_nth(ast
, 1), env
);
242 SELECT type_id
INTO type FROM types.
value WHERE value_id
= cond
;
243 IF type = 0 OR type = 1 THEN -- nil or false
244 IF types.
_count(ast
) > 3 THEN
245 ast
:= types.
_nth(ast
, 3);
251 ast
:= types.
_nth(ast
, 2);
255 WHEN a0sym
= 'fn*' THEN
257 RETURN types.
_malfunc(types.
_nth(ast
, 2), types.
_nth(ast
, 1), env
);
261 el
:= mal.
eval_ast(ast
, env
);
262 SELECT type_id
, val_string
, ast_id
, params_id
, env_id
263 INTO type, fname
, fast
, fparams
, fenv
264 FROM types.
value WHERE value_id
= types.
_first(el
);
265 args
:= types.
_restArray(el
);
267 EXECUTE format('SELECT %s($1);', fname
)
268 INTO result USING args
;
271 env
:= envs.
new(fenv
, fparams
, args
);
275 RAISE
EXCEPTION 'Invalid function call';
280 END; $$
LANGUAGE plpgsql
;
283 CREATE FUNCTION mal.
PRINT(exp integer) RETURNS varchar AS $$
285 RETURN printer.
pr_str(exp);
286 END; $$
LANGUAGE plpgsql
;
291 -- repl_env is environment 0
293 CREATE FUNCTION mal.
REP(line
varchar) RETURNS varchar AS $$
295 RETURN mal.
PRINT(mal.
EVAL(mal.
READ(line
), 0));
296 END; $$
LANGUAGE plpgsql
;
298 -- core.sql: defined using SQL (in core.sql)
299 -- repl_env is created and populated with core functions in by core.sql
300 CREATE FUNCTION mal.
mal_eval(args
integer[]) RETURNS integer AS $$
302 RETURN mal.
EVAL(args
[1], 0);
303 END; $$
LANGUAGE plpgsql
;
304 INSERT INTO types.
value (type_id
, val_string
) VALUES (11, 'mal.mal_eval');
306 SELECT envs.
vset(0, 'eval',
307 (SELECT value_id
FROM types.
value
308 WHERE val_string
= 'mal.mal_eval')) \g
'/dev/null'
309 -- *ARGV* values are set by RUN
310 SELECT envs.
vset(0, '*ARGV*', mal.
READ('()')) \g
'/dev/null'
313 -- core.mal: defined using the language itself
314 SELECT mal.
REP('(def! *host-language* "plpqsql")') \g
'/dev/null'
315 SELECT mal.
REP('(def! not (fn* (a) (if a false true)))') \g
'/dev/null'
316 SELECT mal.
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g
'/dev/null'
317 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'
319 CREATE FUNCTION mal.
MAIN(pwd
varchar, argstring
varchar DEFAULT NULL)
320 RETURNS integer AS $$
326 PERFORM envs.
vset(0, '*PWD*', types.
_stringv(pwd
));
328 IF argstring
IS NOT NULL THEN
329 allargs
:= mal.
READ(argstring
);
330 PERFORM envs.
vset(0, '*ARGV*', types.
_rest(allargs
));
331 PERFORM mal.
REP('(load-file ' ||
332 printer.
pr_str(types.
_first(allargs
)) ||
')');
334 PERFORM io.
wait_flushed(1);
338 PERFORM mal.
REP('(println (str "Mal [" *host-language* "]"))');
342 line
:= io.
readline('user> ', 0);
347 IF line
NOT IN ('', E
'\n') THEN
348 output := mal.
REP(line
);
349 PERFORM io.
writeline(output);
352 EXCEPTION WHEN OTHERS THEN
353 PERFORM io.
writeline('Error: ' || SQLERRM
);
356 END; $$
LANGUAGE plpgsql
;