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 $$
152 -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast));
153 SELECT type_id
INTO type FROM types.
value WHERE value_id
= ast
;
155 RETURN mal.
eval_ast(ast
, env
);
158 ast
:= mal.
macroexpand(ast
, env
);
159 SELECT type_id
INTO type FROM types.
value WHERE value_id
= ast
;
161 RETURN mal.
eval_ast(ast
, env
);
163 IF types.
_count(ast
) = 0 THEN
167 a0
:= types.
_first(ast
);
168 IF types.
_symbol_Q(a0
) THEN
169 a0sym
:= (SELECT val_string
FROM types.
value WHERE value_id
= a0
);
171 a0sym
:= '__<*fn*>__';
175 WHEN a0sym
= 'def!' THEN
177 RETURN envs.
set(env
, types.
_nth(ast
, 1),
178 mal.
EVAL(types.
_nth(ast
, 2), env
));
180 WHEN a0sym
= 'let*' THEN
182 let_env
:= envs.
new(env
);
183 a1
:= types.
_nth(ast
, 1);
184 binds
:= (SELECT val_seq
FROM types.
value WHERE value_id
= a1
);
186 WHILE idx
< array_length(binds
, 1) LOOP
187 PERFORM envs.
set(let_env
, binds
[idx
],
188 mal.
EVAL(binds
[idx
+1], let_env
));
192 ast
:= types.
_nth(ast
, 2);
195 WHEN a0sym
= 'quote' THEN
197 RETURN types.
_nth(ast
, 1);
199 WHEN a0sym
= 'quasiquote' THEN
201 ast
:= mal.
quasiquote(types.
_nth(ast
, 1));
204 WHEN a0sym
= 'defmacro!' THEN
206 fn
:= mal.
EVAL(types.
_nth(ast
, 2), env
);
207 fn
:= types.
_macro(fn
);
208 RETURN envs.
set(env
, types.
_nth(ast
, 1), fn
);
210 WHEN a0sym
= 'macroexpand' THEN
212 RETURN mal.
macroexpand(types.
_nth(ast
, 1), env
);
214 WHEN a0sym
= 'do' THEN
216 PERFORM mal.
eval_ast(types.
_slice(ast
, 1, types.
_count(ast
)-1), env
);
217 ast
:= types.
_nth(ast
, types.
_count(ast
)-1);
220 WHEN a0sym
= 'if' THEN
222 cond
:= mal.
EVAL(types.
_nth(ast
, 1), env
);
223 SELECT type_id
INTO type FROM types.
value WHERE value_id
= cond
;
224 IF type = 0 OR type = 1 THEN -- nil or false
225 IF types.
_count(ast
) > 3 THEN
226 ast
:= types.
_nth(ast
, 3);
232 ast
:= types.
_nth(ast
, 2);
236 WHEN a0sym
= 'fn*' THEN
238 RETURN types.
_malfunc(types.
_nth(ast
, 2), types.
_nth(ast
, 1), env
);
242 el
:= mal.
eval_ast(ast
, env
);
243 SELECT type_id
, val_string
, ast_id
, params_id
, env_id
244 INTO type, fname
, fast
, fparams
, fenv
245 FROM types.
value WHERE value_id
= types.
_first(el
);
246 args
:= types.
_restArray(el
);
248 EXECUTE format('SELECT %s($1);', fname
)
249 INTO result USING args
;
252 env
:= envs.
new(fenv
, fparams
, args
);
256 RAISE
EXCEPTION 'Invalid function call';
261 END; $$
LANGUAGE plpgsql
;
264 CREATE FUNCTION mal.
PRINT(exp integer) RETURNS varchar AS $$
266 RETURN printer.
pr_str(exp);
267 END; $$
LANGUAGE plpgsql
;
272 -- repl_env is environment 0
274 CREATE FUNCTION mal.
REP(line
varchar) RETURNS varchar AS $$
276 RETURN mal.
PRINT(mal.
EVAL(mal.
READ(line
), 0));
277 END; $$
LANGUAGE plpgsql
;
279 -- core.sql: defined using SQL (in core.sql)
280 -- repl_env is created and populated with core functions in by core.sql
281 CREATE FUNCTION mal.
mal_eval(args
integer[]) RETURNS integer AS $$
283 RETURN mal.
EVAL(args
[1], 0);
284 END; $$
LANGUAGE plpgsql
;
285 INSERT INTO types.
value (type_id
, val_string
) VALUES (11, 'mal.mal_eval');
287 SELECT envs.
vset(0, 'eval',
288 (SELECT value_id
FROM types.
value
289 WHERE val_string
= 'mal.mal_eval')) \g
'/dev/null'
290 -- *ARGV* values are set by RUN
291 SELECT envs.
vset(0, '*ARGV*', mal.
READ('()')) \g
'/dev/null'
294 -- core.mal: defined using the language itself
295 SELECT mal.
REP('(def! not (fn* (a) (if a false true)))') \g
'/dev/null'
296 SELECT mal.
REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g
'/dev/null'
297 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'
299 CREATE FUNCTION mal.
MAIN(pwd
varchar, argstring
varchar DEFAULT NULL)
300 RETURNS integer AS $$
306 PERFORM envs.
vset(0, '*PWD*', types.
_stringv(pwd
));
308 IF argstring
IS NOT NULL THEN
309 allargs
:= mal.
READ(argstring
);
310 PERFORM envs.
vset(0, '*ARGV*', types.
_rest(allargs
));
311 PERFORM mal.
REP('(load-file ' ||
312 printer.
pr_str(types.
_first(allargs
)) ||
')');
314 PERFORM io.
wait_flushed(1);
321 line
:= io.
readline('user> ', 0);
326 IF line
NOT IN ('', E
'\n') THEN
327 output := mal.
REP(line
);
328 PERFORM io.
writeline(output);
331 EXCEPTION WHEN OTHERS THEN
332 PERFORM io.
writeline('Error: ' || SQLERRM
);
335 END; $$
LANGUAGE plpgsql
;