kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-10 12:47:45 +03:00
Code Issues Projects Releases Wiki Activity

plpgsql: steps 4-6.

Browse Source
This commit is contained in:
Joel Martin 2016-03-22 00:53:31 -05:00
parent adc5b4fb54
commit 5340418b47
13 changed files with 1494 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -104,6 +104,7 @@ test_EXCLUDES += test^bash^step5 # never completes at 10,000
test_EXCLUDES += test^make^step5 # no TCO capability (iteration or recursion)
test_EXCLUDES += test^mal^step5 # host impl dependent
test_EXCLUDES += test^matlab^step5 # never completes at 10,000
test_EXCLUDES += test^plpgsql^step5 # too slow for 10,000
perf_EXCLUDES = mal # TODO: fix this

27
plpgsql/Makefile Normal file
View File

@ -0,0 +1,27 @@
# POSTGRES OR MYSQL
MODE = POSTGRES
SOURCES = init.sql types.sql reader.sql printer.sql env.sql step4_if_fn_do.sql
SOURCES_LISP = env.sql step4_if_fn_do.sql
#STEP0_DEPS = init.sql
#STEP1_DEPS = $(STEP0_DEPS) types.sql reader.sql printer.sql
#
#step%.sql: step%.sql.in
# cpp -P -traditional-cpp -D $(MODE) $< $@
#
#step0_repl.sql: $(STEP0_DEPS)
#step1_read_print.sql: $(STEP1_DEPS)
#
#clean:
# rm -f step*.sql
#
.PHONY: stats tests $(TESTS)
stats: $(SOURCES)
@wc $^
@printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]"
stats-lisp: $(SOURCES_LISP)
@wc $^
@printf "%5s %5s %5s %s\n" `grep -E "^[[:space:]]*#|^[[:space:]]*$$" $^ | wc` "[comments/blanks]"

258
plpgsql/core.sql Normal file
View File

@ -0,0 +1,258 @@
CREATE OR REPLACE FUNCTION mal_equal(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _wraptf(_equal_Q(args[1], args[2]));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_equal');
-- string functions
CREATE OR REPLACE FUNCTION mal_pr_str(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _string(pr_str_array(args, ' ', true));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_pr_str');
CREATE OR REPLACE FUNCTION mal_str(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _string(pr_str_array(args, '', false));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_str');
CREATE OR REPLACE FUNCTION mal_prn(args integer[]) RETURNS integer AS $$
BEGIN
RAISE NOTICE '%', pr_str_array(args, ' ', true);
RETURN 0; -- nil
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_prn');
CREATE OR REPLACE FUNCTION mal_println(args integer[]) RETURNS integer AS $$
BEGIN
RAISE NOTICE '%', pr_str_array(args, ' ', false);
RETURN 0; -- nil
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_println');
CREATE OR REPLACE FUNCTION mal_read_string(args integer[]) RETURNS integer AS $$
BEGIN
RETURN read_str(_vstring(args[1]));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_read_string');
-- See:
-- http://shuber.io/reading-from-the-filesystem-with-postgres/
CREATE OR REPLACE FUNCTION mal_slurp(args integer[]) RETURNS integer AS $$
DECLARE
fname varchar;
tmp varchar;
lines varchar[];
content varchar;
BEGIN
fname := _vstring(args[1]);
IF fname NOT LIKE '/%' THEN
fname := _vstring(env_vget(0, '*PWD*')) || '/' || fname;
END IF;
tmp := CAST(round(random()*1000000) AS varchar);
EXECUTE format('CREATE TEMP TABLE %I (content text)', tmp);
EXECUTE format('COPY %I FROM %L', tmp, fname);
EXECUTE format('SELECT ARRAY(SELECT content FROM %I)', tmp) INTO lines;
EXECUTE format('DROP TABLE %I', tmp);
content := array_to_string(lines, E'\n') || E'\n';
RETURN _string(content);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_slurp');
-- number functions
-- integer comparison
CREATE OR REPLACE FUNCTION mal_intcmp(op varchar, args integer[]) RETURNS integer AS $$
DECLARE a integer; b integer; result boolean;
BEGIN
SELECT val_int INTO a FROM value WHERE value_id = args[1];
SELECT val_int INTO b FROM value WHERE value_id = args[2];
EXECUTE format('SELECT $1 %s $2;', op) INTO result USING a, b;
RETURN _wraptf(result);
END; $$ LANGUAGE plpgsql;
-- integer operation
CREATE OR REPLACE FUNCTION mal_intop(op varchar, args integer[]) RETURNS integer AS $$
DECLARE a integer; b integer; result integer;
BEGIN
SELECT val_int INTO a FROM value WHERE value_id = args[1];
SELECT val_int INTO b FROM value WHERE value_id = args[2];
EXECUTE format('INSERT INTO value (type_id, val_int) VALUES (3, $1 %s $2)
RETURNING value_id;', op) INTO result USING a, b;
RETURN result;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION mal_lt(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intcmp('<', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_lt');
CREATE OR REPLACE FUNCTION mal_lte(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intcmp('<=', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_lte');
CREATE OR REPLACE FUNCTION mal_gt(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intcmp('>', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_gt');
CREATE OR REPLACE FUNCTION mal_gte(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intcmp('>=', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_gte');
CREATE OR REPLACE FUNCTION mal_add(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intop('+', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_add');
CREATE OR REPLACE FUNCTION mal_subtract(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intop('-', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_subtract');
CREATE OR REPLACE FUNCTION mal_multiply(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intop('*', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_multiply');
CREATE OR REPLACE FUNCTION mal_divide(args integer[]) RETURNS integer AS $$
BEGIN
RETURN mal_intop('/', args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_divide');
-- collection functions
CREATE OR REPLACE FUNCTION mal_list(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _arrayToValue(args);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_list');
CREATE OR REPLACE FUNCTION mal_list_Q(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _wraptf(_list_Q(args[1]));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_list_Q');
-- sequence functions
CREATE OR REPLACE FUNCTION mal_empty_Q(args integer[]) RETURNS integer AS $$
BEGIN
IF _sequential_Q(args[1]) AND _count(args[1]) = 0 THEN
RETURN 2;
ELSE
RETURN 1;
END IF;
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_empty_Q');
CREATE OR REPLACE FUNCTION mal_count(args integer[]) RETURNS integer AS $$
BEGIN
IF _sequential_Q(args[1]) THEN
RETURN _numToValue(_count(args[1]));
ELSIF _nil_Q(args[1]) THEN
RETURN _numToValue(0);
ELSE
RAISE EXCEPTION 'count called on non-sequence';
END IF;
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_count');
-- atom functions
CREATE OR REPLACE FUNCTION mal_atom(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _atom(args[1]);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_atom');
-- atom functions
CREATE OR REPLACE FUNCTION mal_atom_Q(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _wraptf(_atom_Q(args[1]));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_atom_Q');
CREATE OR REPLACE FUNCTION mal_deref(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _deref(args[1]);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_deref');
CREATE OR REPLACE FUNCTION mal_reset_BANG(args integer[]) RETURNS integer AS $$
BEGIN
RETURN _reset_BANG(args[1], args[2]);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_reset_BANG');
CREATE OR REPLACE FUNCTION mal_swap_BANG(args integer[]) RETURNS integer AS $$
DECLARE
atm integer;
fargs integer[];
BEGIN
atm := args[1];
fargs := array_cat(ARRAY[_deref(atm)], args[3:array_length(args, 1)]);
RETURN _reset_BANG(atm, _apply(args[2], fargs));
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_swap_BANG');
-- repl_env is environment 0
INSERT INTO env (env_id, outer_id) VALUES (0, NULL);
-- core namespace
INSERT INTO env_data (env_id, key, value_id) VALUES
(0, '=', (SELECT value_id FROM value WHERE function_name = 'mal_equal')),
(0, 'pr-str', (SELECT value_id FROM value WHERE function_name = 'mal_pr_str')),
(0, 'str', (SELECT value_id FROM value WHERE function_name = 'mal_str')),
(0, 'prn', (SELECT value_id FROM value WHERE function_name = 'mal_prn')),
(0, 'println', (SELECT value_id FROM value WHERE function_name = 'mal_println')),
(0, 'read-string', (SELECT value_id FROM value WHERE function_name = 'mal_read_string')),
(0, 'slurp', (SELECT value_id FROM value WHERE function_name = 'mal_slurp')),
(0, '<', (SELECT value_id FROM value WHERE function_name = 'mal_lt')),
(0, '<=', (SELECT value_id FROM value WHERE function_name = 'mal_lte')),
(0, '>', (SELECT value_id FROM value WHERE function_name = 'mal_gt')),
(0, '>=', (SELECT value_id FROM value WHERE function_name = 'mal_gte')),
(0, '+', (SELECT value_id FROM value WHERE function_name = 'mal_add')),
(0, '-', (SELECT value_id FROM value WHERE function_name = 'mal_subtract')),
(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_multiply')),
(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide')),
(0, 'list', (SELECT value_id FROM value WHERE function_name = 'mal_list')),
(0, 'list?', (SELECT value_id FROM value WHERE function_name = 'mal_list_Q')),
(0, 'empty?', (SELECT value_id FROM value WHERE function_name = 'mal_empty_Q')),
(0, 'count', (SELECT value_id FROM value WHERE function_name = 'mal_count')),
(0, 'atom', (SELECT value_id FROM value WHERE function_name = 'mal_atom')),
(0, 'atom?', (SELECT value_id FROM value WHERE function_name = 'mal_atom_Q')),
(0, 'deref', (SELECT value_id FROM value WHERE function_name = 'mal_deref')),
(0, 'reset!', (SELECT value_id FROM value WHERE function_name = 'mal_reset_BANG')),
(0, 'swap!', (SELECT value_id FROM value WHERE function_name = 'mal_swap_BANG'))
;

102
plpgsql/env.sql
View File

@ -22,6 +22,7 @@ ALTER TABLE env_data ADD CONSTRAINT fk_env_data_env_id
-- -----------------------
-- env_new
CREATE OR REPLACE FUNCTION env_new(outer_env integer)
RETURNS integer AS $$
DECLARE
@ -33,35 +34,76 @@ BEGIN
RETURN e;
END; $$ LANGUAGE plpgsql;
-- env_new_bindings
CREATE OR REPLACE FUNCTION env_new_bindings(outer_env integer,
binds integer,
exprs integer[])
RETURNS integer AS $$
DECLARE
e integer;
cid integer;
i integer;
bind integer;
bsym varchar;
expr integer;
BEGIN
e := env_new(outer_env);
SELECT collection_id INTO cid FROM value
WHERE value_id = binds;
FOR bind, i IN (SELECT value_id, idx FROM collection
WHERE collection_id = cid
ORDER BY idx)
LOOP
expr := exprs[i+1];
bsym := _vstring(bind);
--RAISE NOTICE 'i: %, bind: %, expr: %', i, bind, expr;
IF bsym = '&' THEN
bind := (SELECT value_id FROM collection
WHERE collection_id = cid
AND idx = i+1);
PERFORM env_set(e, bind, _arrayToValue(exprs[i+1:array_length(exprs, 1)]));
RETURN e;
END IF;
PERFORM env_vset(e, bsym, expr);
END LOOP;
RETURN e;
END; $$ LANGUAGE plpgsql;
-- env_vset
-- like env_set but takes a varchar key instead of value_id
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
RETURNS integer AS $$
BEGIN
-- upsert
IF (SELECT 1 FROM env_data WHERE env_id=env AND env_data.key=name) THEN
UPDATE env_data SET value_id = val
WHERE env_id=env AND env_data.key=name;
ELSE
INSERT INTO env_data (env_id, key, value_id)
VALUES (env, name, val);
END IF;
RETURN val;
END; $$ LANGUAGE plpgsql;
-- env_set
CREATE OR REPLACE FUNCTION env_set(env integer, key integer, val integer)
RETURNS integer AS $$
DECLARE
symkey varchar;
BEGIN
symkey := (SELECT value FROM string
WHERE string_id = (SELECT val_string_id FROM value
WHERE value_id = key));
-- upsert
IF (SELECT 1 FROM env_data WHERE env_id=env AND env_data.key=symkey) THEN
UPDATE env_data SET value_id = val
WHERE env_id=env AND env_data.key=symkey;
ELSE
INSERT INTO env_data (env_id, key, value_id)
VALUES (env, symkey, val);
END IF;
RETURN val;
symkey := _vstring(key);
RETURN env_vset(env, symkey, val);
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION env_find(env integer, key integer)
-- env_find
CREATE OR REPLACE FUNCTION env_find(env integer, symkey varchar)
RETURNS integer AS $$
DECLARE
symkey varchar;
outer_id integer;
val integer;
BEGIN
symkey := (SELECT value FROM string
WHERE string_id = (SELECT val_string_id FROM value
WHERE value_id = key));
SELECT e.outer_id INTO outer_id FROM env e WHERE e.env_id = env;
SELECT value_id INTO val FROM env_data
WHERE env_id = env AND env_data.key = symkey;
@ -70,23 +112,21 @@ BEGIN
RETURN env;
ELSIF outer_id IS NOT NULL THEN
--RAISE NOTICE 'symkey: %, not found in: %, trying: %', symkey, env, outer_id;
RETURN env_find(outer_id, key);
RETURN env_find(outer_id, symkey);
ELSE
RETURN NULL;
END IF;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION env_get(env integer, key integer)
-- env_vget
CREATE OR REPLACE FUNCTION env_vget(env integer, symkey varchar)
RETURNS integer AS $$
DECLARE
symkey varchar;
result integer;
e integer;
BEGIN
symkey := (SELECT value FROM string
WHERE string_id = (SELECT val_string_id FROM value
WHERE value_id = key));
e := env_find(env, key);
e := env_find(env, symkey);
--RAISE NOTICE 'env_find env: %, symkey: % -> e: %', env, symkey, e;
IF e IS NULL THEN
RAISE EXCEPTION '''%'' not found', symkey;
@ -100,6 +140,20 @@ BEGIN
RETURN result;
END; $$ LANGUAGE plpgsql;
-- env_get
CREATE OR REPLACE FUNCTION env_get(env integer, key integer)
RETURNS integer AS $$
DECLARE
symkey varchar;
result integer;
e integer;
BEGIN
RETURN env_vget(env, _vstring(key));
END; $$ LANGUAGE plpgsql;
-- env_print
-- For debugging
CREATE OR REPLACE FUNCTION env_print(env integer)
RETURNS void AS $$
DECLARE

76
plpgsql/printer.sql
View File

@ -2,13 +2,33 @@
-- printer.sql
CREATE OR REPLACE FUNCTION
pr_str(ast integer) RETURNS varchar AS $$
pr_str_array(arr integer[], sep varchar, print_readably boolean)
RETURNS varchar AS $$
DECLARE
i integer;
res varchar[];
BEGIN
IF array_length(arr, 1) > 0 THEN
FOR i IN array_lower(arr, 1) .. array_upper(arr, 1)
LOOP
res := array_append(res, pr_str(arr[i], print_readably));
END LOOP;
RETURN array_to_string(res, sep);
ELSE
RETURN '';
END IF;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION
pr_str(ast integer, print_readably boolean DEFAULT true)
RETURNS varchar AS $$
DECLARE
re varchar = E'[[:space:] ,]*(~@|[\\[\\]{}()\'`~@]|"(?:[\\\\].|[^\\\\"])*"|;.*|[^\\s \\[\\]{}()\'"`~@,;]*)';
type integer;
cid integer;
vid integer;
res varchar;
pid integer;
str varchar;
BEGIN
-- RAISE NOTICE 'pr_str ast: %', ast;
SELECT type_id FROM value WHERE value_id = ast INTO type;
@ -17,42 +37,60 @@ BEGIN
WHEN type = 0 THEN RETURN 'nil';
WHEN type = 1 THEN RETURN 'false';
WHEN type = 2 THEN RETURN 'true';
WHEN type = 3 THEN
WHEN type = 3 THEN -- integer
RETURN CAST((SELECT val_int
FROM value WHERE value_id = ast) as varchar);
WHEN type = 5 THEN
RETURN '"' ||
(SELECT value FROM string
WHERE string_id = (SELECT val_string_id
FROM value WHERE value_id = ast)) ||
'"';
WHEN type = 7 THEN
RETURN (SELECT value FROM string
WHERE string_id = (SELECT val_string_id
FROM value WHERE value_id = ast));
WHEN type = 8 THEN
WHEN type = 5 THEN -- string
str := _vstring(ast);
IF print_readably THEN
str := replace(str, E'\\', '\\');
str := replace(str, '"', '\"');
str := replace(str, E'\n', '\n');
RETURN '"' || str || '"';
ELSE
RETURN str;
END IF;
WHEN type = 7 THEN -- symbol
RETURN _vstring(ast);
WHEN type = 8 THEN -- list
BEGIN
cid := (SELECT collection_id FROM value WHERE value_id = ast);
RETURN '(' ||
array_to_string(array(
SELECT pr_str(c.value_id) FROM collection c
SELECT pr_str(c.value_id, print_readably)
FROM collection c
WHERE c.collection_id = cid), ' ') ||
')';
END;
WHEN type = 9 THEN
WHEN type = 9 THEN -- vector
BEGIN
cid := (SELECT collection_id FROM value WHERE value_id = ast);
RETURN '[' ||
array_to_string(array(
SELECT pr_str(c.value_id) FROM collection c
SELECT pr_str(c.value_id, print_readably)
FROM collection c
WHERE c.collection_id = cid), ' ') ||
']';
END;
WHEN type = 11 THEN
BEGIN
WHEN type = 11 THEN -- native function
RETURN '#<function ' ||
(SELECT function_name FROM value WHERE value_id = ast) ||
'>';
WHEN type = 12 THEN -- mal function
BEGIN
cid := (SELECT collection_id FROM value WHERE value_id = ast);
SELECT params_id, value_id
INTO pid, vid
FROM collection WHERE collection_id = cid;
RETURN '(fn* ' || pr_str(pid, print_readably) ||
' ' || pr_str(vid, print_readably) || ')';
END;
WHEN type = 13 THEN -- atom
BEGIN
cid := (SELECT collection_id FROM value WHERE value_id = ast);
SELECT value_id INTO vid
FROM collection WHERE collection_id = cid;
RETURN '(atom ' || pr_str(vid, print_readably) || ')';
END;
ELSE
RETURN 'unknown';

21
plpgsql/reader.sql
View File

@ -4,7 +4,7 @@
CREATE OR REPLACE FUNCTION
tokenize(str varchar) RETURNS varchar[] AS $$
DECLARE
re varchar = E'[[:space:] ,]*(~@|[\\[\\]{}()\'`~@]|"(?:[\\\\].|[^\\\\"])*"|;.*|[^\\s \\[\\]{}()\'"`~@,;]*)';
re varchar = E'[[:space:] ,]*(~@|[\\[\\]{}()\'`~@]|"(?:[\\\\].|[^\\\\"])*"|;[^\n]*|[^\\s \\[\\]{}()\'"`~@,;]*)';
BEGIN
RETURN ARRAY(SELECT tok FROM
(SELECT (regexp_matches(str, re, 'g'))[1] AS tok) AS x
@ -18,6 +18,7 @@ CREATE OR REPLACE FUNCTION
read_atom(tokens varchar[], INOUT pos integer, OUT result integer) AS $$
DECLARE
str_id integer;
str varchar;
token varchar;
BEGIN
token := tokens[pos];
@ -36,20 +37,14 @@ BEGIN
RETURNING value_id INTO result;
ELSIF token ~ '^".*"' THEN
-- string
INSERT INTO string (value)
VALUES (substring(token FROM 2 FOR (char_length(token)-2)))
RETURNING string_id INTO str_id;
INSERT INTO value (type_id, val_string_id)
VALUES (5, str_id)
RETURNING value_id INTO result;
str := substring(token FROM 2 FOR (char_length(token)-2));
str := replace(str, '\"', '"');
str := replace(str, '\n', E'\n');
str := replace(str, '\\', E'\\');
result := _string(str);
ELSE
-- symbol
INSERT INTO string (value)
VALUES (token)
RETURNING string_id INTO str_id;
INSERT INTO value (type_id, val_string_id)
VALUES (7, str_id)
RETURNING value_id INTO result;
result := _symbol(token);
END IF;
END; $$ LANGUAGE plpgsql;

19
plpgsql/step2_eval.sql
View File

@ -31,9 +31,7 @@ BEGIN
CASE
WHEN type = 7 THEN
BEGIN
symkey := (SELECT value FROM string
WHERE string_id = (SELECT val_string_id FROM value
WHERE value_id = ast));
symkey := _vstring(ast);
SELECT e.value_id FROM env e INTO result
WHERE e.env_id = env
AND e.key = symkey;
@ -106,6 +104,12 @@ CREATE TABLE env (
value_id integer NOT NULL
);
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
RETURNS void AS $$
BEGIN
INSERT INTO env (env_id, key, value_id) VALUES (env, name, val);
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION mal_intop(op varchar, args integer[]) RETURNS integer AS $$
DECLARE a integer; b integer; result integer;
@ -132,11 +136,10 @@ INSERT INTO value (type_id, function_name) VALUES (11, 'mal_multiply');
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_divide');
-- repl_env is environment 0
INSERT INTO env (env_id, key, value_id)
VALUES (0, '+', (SELECT value_id FROM value WHERE function_name = 'mal_add')),
(0, '-', (SELECT value_id FROM value WHERE function_name = 'mal_subtract')),
(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_multiply')),
(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
SELECT env_vset(0, '+', (SELECT value_id FROM value WHERE function_name = 'mal_add'));
SELECT env_vset(0, '-', (SELECT value_id FROM value WHERE function_name = 'mal_subtract'));
SELECT env_vset(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_multiply'));
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$

9
plpgsql/step3_env.sql
View File

@ -167,11 +167,10 @@ INSERT INTO value (type_id, function_name) VALUES (11, 'mal_divide');
-- -- repl_env is environment 0
INSERT INTO env (env_id, outer_id) VALUES (0, NULL);
INSERT INTO env_data (env_id, key, value_id)
VALUES (0, '+', (SELECT value_id FROM value WHERE function_name = 'mal_add')),
(0, '-', (SELECT value_id FROM value WHERE function_name = 'mal_subtract')),
(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_multiply')),
(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
SELECT env_vset(0, '+', (SELECT value_id FROM value WHERE function_name = 'mal_add'));
SELECT env_vset(0, '-', (SELECT value_id FROM value WHERE function_name = 'mal_subtract'));
SELECT env_vset(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_multiply'));
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$

196
plpgsql/step4_if_fn_do.sql Normal file
View File

@ -0,0 +1,196 @@
\set VERBOSITY 'terse'
\i init.sql
\i types.sql
\i reader.sql
\i printer.sql
\i env.sql
\i core.sql
-- ---------------------------------------------------------
-- step1_read_print.sql
-- read
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
BEGIN
RETURN read_str(line);
END; $$ LANGUAGE plpgsql;
-- eval
CREATE OR REPLACE FUNCTION just_add(args integer[]) RETURNS integer AS $$
BEGIN RETURN args[1] + args[2]; END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
symkey varchar;
vid integer;
i integer;
src_coll_id integer;
dst_coll_id integer = NULL;
e integer;
result integer;
BEGIN
SELECT type_id INTO type FROM value WHERE value_id = ast;
CASE
WHEN type = 7 THEN
BEGIN
result := env_get(env, ast);
END;
WHEN type = 8 OR type = 9 THEN
BEGIN
src_coll_id := (SELECT collection_id FROM value WHERE value_id = ast);
FOR vid, i IN (SELECT value_id, idx FROM collection
WHERE collection_id = src_coll_id)
LOOP
e := EVAL(vid, env);
IF dst_coll_id IS NULL THEN
dst_coll_id := COALESCE((SELECT Max(collection_id)
FROM collection)+1,0);
END IF;
-- Evaluated each entry
INSERT INTO collection (collection_id, idx, value_id)
VALUES (dst_coll_id, i, e);
END LOOP;
-- Create value entry pointing to new collection
INSERT INTO value (type_id, collection_id)
VALUES (type, dst_coll_id)
RETURNING value_id INTO result;
END;
ELSE
result := ast;
END CASE;
RETURN result;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
a0 integer;
a0sym varchar;
a1 integer;
let_env integer;
binds integer[];
exprs integer[];
el integer;
fn integer;
fname varchar;
args integer[];
cond integer;
fast integer;
fparams integer;
fenv integer;
result integer;
BEGIN
-- RAISE NOTICE 'EVAL: % [%]', pr_str(ast), ast;
SELECT type_id INTO type FROM value WHERE value_id = ast;
IF type <> 8 THEN
RETURN eval_ast(ast, env);
END IF;
a0 := _first(ast);
IF _symbol_Q(a0) THEN
a0sym := (SELECT string.value FROM string
INNER JOIN value ON value.val_string_id=string.string_id
WHERE value.value_id = a0);
ELSE
a0sym := '__<*fn*>__';
END IF;
--RAISE NOTICE 'ast: %, a0sym: %', ast, a0sym;
CASE
WHEN a0sym = 'def!' THEN
BEGIN
RETURN env_set(env, _nth(ast, 1), EVAL(_nth(ast, 2), env));
END;
WHEN a0sym = 'let*' THEN
BEGIN
let_env := env_new(env);
a1 := _nth(ast, 1);
binds := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 0
ORDER BY collection.idx);
exprs := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 1
ORDER BY collection.idx);
FOR idx IN array_lower(binds, 1) .. array_upper(binds, 1)
LOOP
PERFORM env_set(let_env, binds[idx], EVAL(exprs[idx], let_env));
END LOOP;
--PERFORM env_print(let_env);
RETURN EVAL(_nth(ast, 2), let_env);
END;
WHEN a0sym = 'do' THEN
BEGIN
el := eval_ast(_rest(ast), env);
RETURN _nth(el, _count(el)-1);
END;
WHEN a0sym = 'if' THEN
BEGIN
cond := EVAL(_nth(ast, 1), env);
SELECT type_id INTO type FROM value WHERE value_id = cond;
IF type = 0 OR type = 1 THEN -- nil or false
IF _count(ast) > 3 THEN
RETURN EVAL(_nth(ast, 3), env);
ELSE
RETURN 0; -- nil
END IF;
ELSE
RETURN EVAL(_nth(ast, 2), env);
END IF;
END;
WHEN a0sym = 'fn*' THEN
BEGIN
RETURN _function(_nth(ast, 2), _nth(ast, 1), env);
END;
ELSE
BEGIN
el := eval_ast(ast, env);
SELECT type_id, collection_id, function_name
INTO type, fn, fname
FROM value WHERE value_id = _first(el);
args := _restArray(el);
IF type = 11 THEN
EXECUTE format('SELECT %s($1);', fname)
INTO result USING args;
RETURN result;
ELSIF type = 12 THEN
SELECT value_id, params_id, env_id
INTO fast, fparams, fenv
FROM collection
WHERE collection_id = fn;
RETURN EVAL(fast, env_new_bindings(fenv, fparams, args));
ELSE
RAISE EXCEPTION 'Invalid function call';
END IF;
END;
END CASE;
END; $$ LANGUAGE plpgsql;
-- print
CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
BEGIN
RETURN pr_str(exp);
END; $$ LANGUAGE plpgsql;
-- repl
-- repl_env is environment 0
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
BEGIN
RETURN PRINT(EVAL(READ(line), 0));
END; $$ LANGUAGE plpgsql;
-- core.sql: defined using SQL (in core.sql)
-- repl_env is created and populated with core functions in by core.sql
-- core.mal: defined using the language itself
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'

204
plpgsql/step5_tco.sql Normal file
View File

@ -0,0 +1,204 @@
\set VERBOSITY 'terse'
\i init.sql
\i types.sql
\i reader.sql
\i printer.sql
\i env.sql
\i core.sql
-- ---------------------------------------------------------
-- step1_read_print.sql
-- read
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
BEGIN
RETURN read_str(line);
END; $$ LANGUAGE plpgsql;
-- eval
CREATE OR REPLACE FUNCTION just_add(args integer[]) RETURNS integer AS $$
BEGIN RETURN args[1] + args[2]; END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
symkey varchar;
vid integer;
i integer;
src_coll_id integer;
dst_coll_id integer = NULL;
e integer;
result integer;
BEGIN
SELECT type_id INTO type FROM value WHERE value_id = ast;
CASE
WHEN type = 7 THEN
BEGIN
result := env_get(env, ast);
END;
WHEN type = 8 OR type = 9 THEN
BEGIN
src_coll_id := (SELECT collection_id FROM value WHERE value_id = ast);
FOR vid, i IN (SELECT value_id, idx FROM collection
WHERE collection_id = src_coll_id)
LOOP
e := EVAL(vid, env);
IF dst_coll_id IS NULL THEN
dst_coll_id := COALESCE((SELECT Max(collection_id)
FROM collection)+1,0);
END IF;
-- Evaluated each entry
INSERT INTO collection (collection_id, idx, value_id)
VALUES (dst_coll_id, i, e);
END LOOP;
-- Create value entry pointing to new collection
INSERT INTO value (type_id, collection_id)
VALUES (type, dst_coll_id)
RETURNING value_id INTO result;
END;
ELSE
result := ast;
END CASE;
RETURN result;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
a0 integer;
a0sym varchar;
a1 integer;
let_env integer;
binds integer[];
exprs integer[];
el integer;
fn integer;
fname varchar;
args integer[];
cond integer;
fast integer;
fparams integer;
fenv integer;
result integer;
BEGIN
LOOP
-- RAISE NOTICE 'EVAL: % [%]', pr_str(ast), ast;
SELECT type_id INTO type FROM value WHERE value_id = ast;
IF type <> 8 THEN
RETURN eval_ast(ast, env);
END IF;
a0 := _first(ast);
IF _symbol_Q(a0) THEN
a0sym := (SELECT string.value FROM string
INNER JOIN value ON value.val_string_id=string.string_id
WHERE value.value_id = a0);
ELSE
a0sym := '__<*fn*>__';
END IF;
--RAISE NOTICE 'ast: %, a0sym: %', ast, a0sym;
CASE
WHEN a0sym = 'def!' THEN
BEGIN
RETURN env_set(env, _nth(ast, 1), EVAL(_nth(ast, 2), env));
END;
WHEN a0sym = 'let*' THEN
BEGIN
let_env := env_new(env);
a1 := _nth(ast, 1);
binds := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 0
ORDER BY collection.idx);
exprs := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 1
ORDER BY collection.idx);
FOR idx IN array_lower(binds, 1) .. array_upper(binds, 1)
LOOP
PERFORM env_set(let_env, binds[idx], EVAL(exprs[idx], let_env));
END LOOP;
env := let_env;
ast := _nth(ast, 2);
CONTINUE; -- TCO
END;
WHEN a0sym = 'do' THEN
BEGIN
PERFORM eval_ast(_slice(ast, 1, _count(ast)-1), env);
ast := _nth(ast, _count(ast)-1);
CONTINUE; -- TCO
END;
WHEN a0sym = 'if' THEN
BEGIN
cond := EVAL(_nth(ast, 1), env);
SELECT type_id INTO type FROM value WHERE value_id = cond;
IF type = 0 OR type = 1 THEN -- nil or false
IF _count(ast) > 3 THEN
ast := _nth(ast, 3);
CONTINUE; -- TCO
ELSE
RETURN 0; -- nil
END IF;
ELSE
ast := _nth(ast, 2);
CONTINUE; -- TCO
END IF;
END;
WHEN a0sym = 'fn*' THEN
BEGIN
RETURN _function(_nth(ast, 2), _nth(ast, 1), env);
END;
ELSE
BEGIN
el := eval_ast(ast, env);
SELECT type_id, collection_id, function_name
INTO type, fn, fname
FROM value WHERE value_id = _first(el);
args := _restArray(el);
IF type = 11 THEN
EXECUTE format('SELECT %s($1);', fname)
INTO result USING args;
RETURN result;
ELSIF type = 12 THEN
SELECT value_id, params_id, env_id
INTO fast, fparams, fenv
FROM collection
WHERE collection_id = fn;
env := env_new_bindings(fenv, fparams, args);
ast := fast;
CONTINUE; -- TCO
ELSE
RAISE EXCEPTION 'Invalid function call';
END IF;
END;
END CASE;
END LOOP;
END; $$ LANGUAGE plpgsql;
-- print
CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
BEGIN
RETURN pr_str(exp);
END; $$ LANGUAGE plpgsql;
-- repl
-- repl_env is environment 0
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
BEGIN
RETURN PRINT(EVAL(READ(line), 0));
END; $$ LANGUAGE plpgsql;
-- core.sql: defined using SQL (in core.sql)
-- repl_env is created and populated with core functions in by core.sql
-- core.mal: defined using the language itself
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'

227
plpgsql/step6_file.sql Normal file
View File

@ -0,0 +1,227 @@
\set VERBOSITY 'terse'
\i init.sql
\i types.sql
\i reader.sql
\i printer.sql
\i env.sql
\i core.sql
-- ---------------------------------------------------------
-- step1_read_print.sql
-- read
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
BEGIN
RETURN read_str(line);
END; $$ LANGUAGE plpgsql;
-- eval
CREATE OR REPLACE FUNCTION just_add(args integer[]) RETURNS integer AS $$
BEGIN RETURN args[1] + args[2]; END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
symkey varchar;
vid integer;
i integer;
src_coll_id integer;
dst_coll_id integer = NULL;
e integer;
result integer;
BEGIN
SELECT type_id INTO type FROM value WHERE value_id = ast;
CASE
WHEN type = 7 THEN
BEGIN
result := env_get(env, ast);
END;
WHEN type = 8 OR type = 9 THEN
BEGIN
src_coll_id := (SELECT collection_id FROM value WHERE value_id = ast);
FOR vid, i IN (SELECT value_id, idx FROM collection
WHERE collection_id = src_coll_id)
LOOP
e := EVAL(vid, env);
IF dst_coll_id IS NULL THEN
dst_coll_id := COALESCE((SELECT Max(collection_id)
FROM collection)+1,0);
END IF;
-- Evaluated each entry
INSERT INTO collection (collection_id, idx, value_id)
VALUES (dst_coll_id, i, e);
END LOOP;
-- Create value entry pointing to new collection
INSERT INTO value (type_id, collection_id)
VALUES (type, dst_coll_id)
RETURNING value_id INTO result;
END;
ELSE
result := ast;
END CASE;
RETURN result;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
DECLARE
type integer;
a0 integer;
a0sym varchar;
a1 integer;
let_env integer;
binds integer[];
exprs integer[];
el integer;
fn integer;
fname varchar;
args integer[];
cond integer;
fast integer;
fparams integer;
fenv integer;
result integer;
BEGIN
LOOP
-- RAISE NOTICE 'EVAL: % [%]', pr_str(ast), ast;
SELECT type_id INTO type FROM value WHERE value_id = ast;
IF type <> 8 THEN
RETURN eval_ast(ast, env);
END IF;
a0 := _first(ast);
IF _symbol_Q(a0) THEN
a0sym := (SELECT string.value FROM string
INNER JOIN value ON value.val_string_id=string.string_id
WHERE value.value_id = a0);
ELSE
a0sym := '__<*fn*>__';
END IF;
--RAISE NOTICE 'ast: %, a0sym: %', ast, a0sym;
CASE
WHEN a0sym = 'def!' THEN
BEGIN
RETURN env_set(env, _nth(ast, 1), EVAL(_nth(ast, 2), env));
END;
WHEN a0sym = 'let*' THEN
BEGIN
let_env := env_new(env);
a1 := _nth(ast, 1);
binds := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 0
ORDER BY collection.idx);
exprs := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
ON collection.collection_id=value.collection_id
WHERE value.value_id = a1
AND (collection.idx % 2) = 1
ORDER BY collection.idx);
FOR idx IN array_lower(binds, 1) .. array_upper(binds, 1)
LOOP
PERFORM env_set(let_env, binds[idx], EVAL(exprs[idx], let_env));
END LOOP;
env := let_env;
ast := _nth(ast, 2);
CONTINUE; -- TCO
END;
WHEN a0sym = 'do' THEN
BEGIN
PERFORM eval_ast(_slice(ast, 1, _count(ast)-1), env);
ast := _nth(ast, _count(ast)-1);
CONTINUE; -- TCO
END;
WHEN a0sym = 'if' THEN
BEGIN
cond := EVAL(_nth(ast, 1), env);
SELECT type_id INTO type FROM value WHERE value_id = cond;
IF type = 0 OR type = 1 THEN -- nil or false
IF _count(ast) > 3 THEN
ast := _nth(ast, 3);
CONTINUE; -- TCO
ELSE
RETURN 0; -- nil
END IF;
ELSE
ast := _nth(ast, 2);
CONTINUE; -- TCO
END IF;
END;
WHEN a0sym = 'fn*' THEN
BEGIN
RETURN _function(_nth(ast, 2), _nth(ast, 1), env);
END;
ELSE
BEGIN
el := eval_ast(ast, env);
SELECT type_id, collection_id, function_name
INTO type, fn, fname
FROM value WHERE value_id = _first(el);
args := _restArray(el);
IF type = 11 THEN
EXECUTE format('SELECT %s($1);', fname)
INTO result USING args;
RETURN result;
ELSIF type = 12 THEN
SELECT value_id, params_id, env_id
INTO fast, fparams, fenv
FROM collection
WHERE collection_id = fn;
env := env_new_bindings(fenv, fparams, args);
ast := fast;
CONTINUE; -- TCO
ELSE
RAISE EXCEPTION 'Invalid function call';
END IF;
END;
END CASE;
END LOOP;
END; $$ LANGUAGE plpgsql;
-- print
CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
BEGIN
RETURN pr_str(exp);
END; $$ LANGUAGE plpgsql;
-- repl
-- repl_env is environment 0
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
BEGIN
RETURN PRINT(EVAL(READ(line), 0));
END; $$ LANGUAGE plpgsql;
-- core.sql: defined using SQL (in core.sql)
-- repl_env is created and populated with core functions in by core.sql
CREATE OR REPLACE FUNCTION mal_eval(args integer[]) RETURNS integer AS $$
BEGIN
RETURN EVAL(args[1], 0);
END; $$ LANGUAGE plpgsql;
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_eval');
SELECT env_vset(0, 'eval',
(SELECT value_id FROM value
WHERE function_name = 'mal_eval')) \g '/dev/null'
-- *ARGV* values are set by RUN
SELECT env_vset(0, '*ARGV*', READ('()'));
-- core.mal: defined using the language itself
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
SELECT REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))') \g '/dev/null'
CREATE OR REPLACE FUNCTION RUN(argstring varchar) RETURNS void AS $$
DECLARE
allargs integer;
BEGIN
allargs := READ(argstring);
PERFORM env_vset(0, '*ARGV*', _rest(allargs));
PERFORM REP('(load-file ' || pr_str(_first(allargs)) || ')');
RETURN;
END; $$ LANGUAGE plpgsql;

414
plpgsql/types.sql
View File

@ -20,6 +20,8 @@ INSERT INTO type VALUES (8, 'list');
INSERT INTO type VALUES (9, 'vector');
INSERT INTO type VALUES (10, 'hashmap');
INSERT INTO type VALUES (11, 'function');
INSERT INTO type VALUES (12, 'malfunc');
INSERT INTO type VALUES (13, 'atom');
-- string values ("interned")
@ -41,13 +43,15 @@ CREATE TABLE collection (
collection_id integer NOT NULL, -- same for items of a collection
idx integer, -- set for list and vector items
key_string_id integer, -- set for hashmap items
value_id integer -- set for all items
value_id integer, -- set for all items (ast for functions)
params_id integer, -- set for functions
env_id integer -- set for functions
);
-- ALTER TABLE collection ADD CONSTRAINT pk_collection
-- PRIMARY KEY (collection_id, idx, key_string_id);
ALTER TABLE collection ADD CONSTRAINT fk_key_string_id
FOREIGN KEY (key_string_id) REFERENCES string(string_id);
-- value_id foreign key is after value table
-- value_id, params_id foreign keys are after value table
-- persistent values
@ -60,7 +64,7 @@ CREATE TABLE value (
val_string_id integer, -- set for strings, keywords, and symbols
collection_id integer, -- set for lists, vectors and hashmaps
-- (NULL for empty collection)
function_name varchar -- set for function types
function_name varchar -- set for native function types
);
ALTER TABLE value ADD CONSTRAINT pk_value_id
PRIMARY KEY (value_id);
@ -72,38 +76,169 @@ ALTER TABLE value ADD CONSTRAINT fk_val_string_id
FOREIGN KEY (val_string_id) REFERENCES string(string_id);
-- ALTER TABLE value ADD CONSTRAINT fk_collection_id
-- FOREIGN KEY (collection_id) REFERENCES collection(collection_id, idx, key_string_id);
-- Reference from collection back to value
-- References from collection back to value
ALTER TABLE collection ADD CONSTRAINT fk_value_id
FOREIGN KEY (value_id) REFERENCES value(value_id);
ALTER TABLE collection ADD CONSTRAINT fk_params_id
FOREIGN KEY (params_id) REFERENCES value(value_id);
INSERT INTO value (value_id, type_id) VALUES (0, 0); -- nil
INSERT INTO value (value_id, type_id) VALUES (1, 1); -- false
INSERT INTO value (value_id, type_id) VALUES (2, 2); -- true
-- ---------------------------------------------------------
-- general functions
CREATE OR REPLACE FUNCTION
_wraptf(val boolean) RETURNS integer AS $$
BEGIN
IF val THEN
RETURN 2;
ELSE
RETURN 1;
END IF;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION
_equal_Q(a integer, b integer) RETURNS boolean AS $$
DECLARE
atype integer;
btype integer;
aint integer;
bint integer;
astr varchar;
bstr varchar;
acid integer;
bcid integer;
i integer;
BEGIN
SELECT type_id INTO atype FROM value WHERE value_id = a;
SELECT type_id INTO btype FROM value WHERE value_id = b;
IF NOT ((atype = btype) OR (_sequential_Q(a) AND _sequential_Q(b))) THEN
RETURN false;
END IF;
CASE
WHEN atype = 3 THEN -- integer
SELECT val_int FROM value INTO aint
WHERE value_id = a;
SELECT val_int FROM value INTO bint
WHERE value_id = b;
RETURN aint = bint;
WHEN atype = 5 OR atype = 7 THEN -- string/symbol
RETURN _vstring(a) = _vstring(b);
WHEN atype = 8 OR atype = 9 THEN -- list/vector
IF _count(a) <> _count(b) THEN
RETURN false;
END IF;
SELECT collection_id FROM value INTO acid
WHERE value_id = a;
SELECT collection_id FROM value INTO bcid
WHERE value_id = b;
FOR i IN 0 .. _count(a)-1
LOOP
SELECT value_id INTO aint FROM collection
WHERE collection_id = acid AND idx = i;
SELECT value_id INTO bint FROM collection
WHERE collection_id = bcid AND idx = i;
IF NOT _equal_Q(aint, bint) THEN
return false;
END IF;
END LOOP;
RETURN true;
ELSE
RETURN a = b;
END CASE;
END; $$ LANGUAGE plpgsql;
-- ---------------------------------------------------------
-- scalar functions
-- _symbol:
-- takes a varchar string
-- returns the value_id of a new symbol
-- _nil_Q:
-- takes a value_id
-- returns the whether value_id is nil
CREATE OR REPLACE FUNCTION
_symbol(name varchar) RETURNS integer AS $$
_nil_Q(id integer) RETURNS boolean AS $$
BEGIN
RETURN id = 0;
END; $$ LANGUAGE plpgsql;
-- _false_Q:
-- takes a value_id
-- returns the whether value_id is false
CREATE OR REPLACE FUNCTION
_false_Q(id integer) RETURNS boolean AS $$
BEGIN
RETURN id = 1;
END; $$ LANGUAGE plpgsql;
-- _true_Q:
-- takes a value_id
-- returns the whether value_id is true
CREATE OR REPLACE FUNCTION
_true_Q(id integer) RETURNS boolean AS $$
BEGIN
RETURN id = 1;
END; $$ LANGUAGE plpgsql;
-- _vstring:
-- takes a value_id for a string
-- returns the varchar value of the string
CREATE OR REPLACE FUNCTION
_vstring(sid integer) RETURNS varchar AS $$
BEGIN
RETURN (SELECT value FROM string
WHERE string_id = (SELECT val_string_id
FROM value WHERE value_id = sid));
END; $$ LANGUAGE plpgsql;
-- _stringish:
-- takes a varchar string
-- returns the value_id of a stringish type (string, symbol, keyword)
CREATE OR REPLACE FUNCTION
_stringish(str varchar, type integer) RETURNS integer AS $$
DECLARE
str_id integer;
result integer;
BEGIN
-- Create string value for name
-- TODO: share string data between string types
-- lookup if it exists
SELECT value_id FROM value INTO result
INNER JOIN string ON value.val_string_id=string.string_id
WHERE string.value = str AND value.type_id = type;
IF result IS NULL THEN
-- Create string value for string
INSERT INTO string (value)
VALUES (name)
VALUES (str)
RETURNING string_id INTO str_id;
-- Create symbol entry
INSERT INTO value (type_id, val_string_id) VALUES (7, str_id)
-- Create actual string entry
INSERT INTO value (type_id, val_string_id)
VALUES (type, str_id)
RETURNING value_id INTO result;
END IF;
RETURN result;
END; $$ LANGUAGE plpgsql;
-- _string:
-- takes a varchar string
-- returns the value_id of a string (new or existing)
CREATE OR REPLACE FUNCTION
_string(str varchar) RETURNS integer AS $$
BEGIN
RETURN _stringish(str, 5);
END; $$ LANGUAGE plpgsql;
-- _symbol:
-- takes a varchar string
-- returns the value_id of a symbol (new or existing)
CREATE OR REPLACE FUNCTION
_symbol(name varchar) RETURNS integer AS $$
BEGIN
RETURN _stringish(name, 7);
END; $$ LANGUAGE plpgsql;
-- _symbol_Q:
-- takes a value_id
-- returns the whether value_id is symbol type
@ -113,31 +248,56 @@ BEGIN
RETURN EXISTS(SELECT 1 FROM value WHERE type_id = 7 AND value_id = id);
END; $$ LANGUAGE plpgsql;
-- _numToValue:
-- takes an integer number
-- returns the value_id for the number
CREATE OR REPLACE FUNCTION
_numToValue(num integer) RETURNS integer AS $$
DECLARE
result integer;
BEGIN
INSERT INTO value (type_id, val_int)
VALUES (3, num)
RETURNING value_id INTO result;
RETURN result;
END; $$ LANGUAGE plpgsql;
-- ---------------------------------------------------------
-- sequence functions
-- _sequential_Q:
-- return true if obj value_id is a list or vector
CREATE OR REPLACE FUNCTION _sequential_Q(obj integer) RETURNS boolean AS $$
BEGIN
IF (SELECT 1 FROM value
WHERE value_id = obj AND (type_id = 8 OR type_id = 9)) THEN
RETURN true;
ELSE
RETURN false;
END IF;
END; $$ LANGUAGE plpgsql;
-- _list:
-- takes a array of value_id integers
-- returns the value_id of a new list
CREATE OR REPLACE FUNCTION
_list(items integer[]) RETURNS integer AS $$
DECLARE
collection_id integer = NULL;
cid integer = NULL;
list_id integer;
BEGIN
IF array_length(items, 1) > 0 THEN
collection_id := COALESCE((SELECT Max(value_id) FROM value)+1,0);
cid := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
FOR idx IN array_lower(items, 1) .. array_upper(items, 1)
LOOP
-- Create entries
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, idx, items[idx]);
VALUES (cid, idx, items[idx]);
END LOOP;
END IF;
-- Create value entry pointing to collection (or NULL)
INSERT INTO value (type_id, collection_id)
VALUES (8, collection_id)
VALUES (8, cid)
RETURNING value_id INTO list_id;
RETURN list_id;
END; $$ LANGUAGE plpgsql;
@ -148,19 +308,19 @@ END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION
_list2(a integer, b integer) RETURNS integer AS $$
DECLARE
collection_id integer = NULL;
cid integer = NULL;
list_id integer;
BEGIN
collection_id := COALESCE((SELECT Max(value_id) FROM value)+1,0);
cid := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
-- Create entries
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, 0, a);
VALUES (cid, 0, a);
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, 1, b);
VALUES (cid, 1, b);
-- Create value entry pointing to collection
INSERT INTO value (type_id, collection_id)
VALUES (8, collection_id)
VALUES (8, cid)
RETURNING value_id INTO list_id;
RETURN list_id;
END; $$ LANGUAGE plpgsql;
@ -171,25 +331,62 @@ END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION
_list2(a integer, b integer, c integer) RETURNS integer AS $$
DECLARE
collection_id integer = NULL;
cid integer = NULL;
list_id integer;
BEGIN
collection_id := COALESCE((SELECT Max(value_id) FROM value)+1,0);
cid := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
-- Create entries
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, 0, a);
VALUES (cid, 0, a);
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, 1, b);
VALUES (cid, 1, b);
INSERT INTO collection (collection_id, idx, value_id)
VALUES (collection_id, 2, c);
VALUES (cid, 2, c);
-- Create value entry pointing to collection
INSERT INTO value (type_id, collection_id)
VALUES (8, collection_id)
VALUES (8, cid)
RETURNING value_id INTO list_id;
RETURN list_id;
END; $$ LANGUAGE plpgsql;
-- _list_Q:
-- return true if obj value_id is a list
CREATE OR REPLACE FUNCTION _list_Q(obj integer) RETURNS boolean AS $$
BEGIN
IF (SELECT 1 FROM value WHERE value_id = obj and type_id = 8) THEN
RETURN true;
ELSE
RETURN false;
END IF;
END; $$ LANGUAGE plpgsql;
-- _arrayToValue:
-- takes an array of value_id integers
-- returns the value_id of new list of those values
CREATE OR REPLACE FUNCTION
_arrayToValue(arr integer[]) RETURNS integer AS $$
DECLARE
dst_coll_id integer = NULL;
i integer;
result integer;
BEGIN
IF array_length(arr, 1) > 0 THEN
dst_coll_id := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
FOR i IN array_lower(arr, 1) .. array_upper(arr, 1)
LOOP
INSERT INTO collection (collection_id, idx, value_id)
VALUES (dst_coll_id, i-1, arr[i]);
END LOOP;
END IF;
INSERT INTO value (type_id, collection_id)
VALUES (8, dst_coll_id)
RETURNING value_id INTO result;
RETURN result;
END; $$ LANGUAGE plpgsql;
-- _nth:
-- takes value_id and an index
-- returns the value_id of nth element in list/vector
@ -220,11 +417,170 @@ END; $$ LANGUAGE plpgsql;
-- returns the array of value_ids
CREATE OR REPLACE FUNCTION
_restArray(seq_id integer) RETURNS integer[] AS $$
DECLARE
result integer;
BEGIN
RETURN ARRAY(SELECT value_id FROM collection
WHERE collection_id = (SELECT collection_id FROM value
WHERE value_id = seq_id)
AND idx > 0);
END; $$ LANGUAGE plpgsql;
-- _slice:
-- takes value_id, a first index and an last index
-- returns the value_id of new list from first (inclusive) to last (exclusive)
CREATE OR REPLACE FUNCTION
_slice(seq_id integer, first integer, last integer) RETURNS integer AS $$
DECLARE
dst_coll_id integer = NULL;
vid integer;
i integer;
result integer;
BEGIN
FOR vid, i IN (SELECT value_id, idx FROM collection
WHERE collection_id = (SELECT collection_id FROM value
WHERE value_id = seq_id)
AND idx >= first AND idx < last
ORDER BY idx)
LOOP
IF dst_coll_id IS NULL THEN
dst_coll_id := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
END IF;
INSERT INTO collection (collection_id, idx, value_id)
VALUES (dst_coll_id, i-1, vid);
END LOOP;
INSERT INTO value (type_id, collection_id)
VALUES (8, dst_coll_id)
RETURNING value_id INTO result;
RETURN result;
END; $$ LANGUAGE plpgsql;
-- _rest:
-- takes value_id
-- returns the value_id of new list
CREATE OR REPLACE FUNCTION
_rest(seq_id integer) RETURNS integer AS $$
DECLARE
BEGIN
RETURN _slice(seq_id, 1, _count(seq_id));
END; $$ LANGUAGE plpgsql;
-- _count:
-- takes value_id
-- returns a count (not value_id)
CREATE OR REPLACE FUNCTION
_count(seq_id integer) RETURNS integer AS $$
DECLARE
result integer;
BEGIN
SELECT count(*) INTO result FROM collection
WHERE collection_id = (SELECT collection_id FROM value
WHERE value_id = seq_id);
RETURN result;
END; $$ LANGUAGE plpgsql;
-- ---------------------------------------------------------
-- function functions
-- _function:
-- takes a ast value_id, params value_id and env_id
-- returns the value_id of a new function
CREATE OR REPLACE FUNCTION
_function(ast integer, params integer, env integer) RETURNS integer AS $$
DECLARE
cid integer = NULL;
result integer;
BEGIN
cid := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
-- Create function entry
INSERT INTO collection (collection_id, value_id, params_id, env_id)
VALUES (cid, ast, params, env);
INSERT INTO value (type_id, collection_id)
VALUES (12, cid)
RETURNING value_id into result;
RETURN result;
END; $$ LANGUAGE plpgsql;
CREATE OR REPLACE FUNCTION
_apply(func integer, args integer[]) RETURNS integer AS $$
DECLARE
type integer;
fcid integer;
fname varchar;
fast integer;
fparams integer;
fenv integer;
result integer;
BEGIN
SELECT type_id, collection_id, function_name
INTO type, fcid, fname
FROM value WHERE value_id = func;
IF type = 11 THEN
EXECUTE format('SELECT %s($1);', fname)
INTO result USING args;
RETURN result;
ELSIF type = 12 THEN
SELECT value_id, params_id, env_id
INTO fast, fparams, fenv
FROM collection
WHERE collection_id = fcid;
-- NOTE: forward reference to current step EVAL function
RETURN EVAL(fast, env_new_bindings(fenv, fparams, args));
ELSE
RAISE EXCEPTION 'Invalid function call';
END IF;
END; $$ LANGUAGE plpgsql;
-- ---------------------------------------------------------
-- atom functions
-- _atom:
-- takes an ast value_id
-- returns a new atom value_id
CREATE OR REPLACE FUNCTION
_atom(val integer) RETURNS integer AS $$
DECLARE
cid integer = NULL;
result integer;
BEGIN
cid := COALESCE((SELECT Max(collection_id) FROM collection)+1,0);
-- Create function entry
INSERT INTO collection (collection_id, value_id) VALUES (cid, val);
INSERT INTO value (type_id, collection_id) VALUES (13, cid)
RETURNING value_id into result;
RETURN result;
END; $$ LANGUAGE plpgsql;
-- _atom_Q:
-- takes a value_id
-- returns the whether value_id is an atom
CREATE OR REPLACE FUNCTION
_atom_Q(id integer) RETURNS boolean AS $$
BEGIN
RETURN EXISTS(SELECT 1 FROM value WHERE type_id = 13 AND value_id = id);
END; $$ LANGUAGE plpgsql;
-- _deref:
-- takes an atom value_id
-- returns a atom value value_id
CREATE OR REPLACE FUNCTION
_deref(atm integer) RETURNS integer AS $$
DECLARE
result integer;
BEGIN
SELECT value_id INTO result FROM collection
WHERE collection_id = (SELECT collection_id FROM value
WHERE value_id = atm);
RETURN result;
END; $$ LANGUAGE plpgsql;
-- _reset_BANG:
-- takes an atom value_id and new value value_id
-- returns a new value value_id
CREATE OR REPLACE FUNCTION
_reset_BANG(atm integer, newval integer) RETURNS integer AS $$
BEGIN
UPDATE collection SET value_id = newval
WHERE collection_id = (SELECT collection_id FROM value
WHERE value_id = atm);
RETURN newval;
END; $$ LANGUAGE plpgsql;

34
plpgsql/wrap.sh
View File

@ -3,16 +3,42 @@
set -e
RL_HISTORY_FILE=${HOME}/.mal-history
MODE="${MODE:-postgres}"
PSQL="psql -q -t -A"
SKIP_INIT="${SKIP_INIT:-}"
PSQL="psql -q -t -A -v ON_ERROR_STOP=1"
[ "${DEBUG}" ] || PSQL="${PSQL} -v VERBOSITY=terse"
# Run a command
run() {
local func=$1 arg=$2
if [ "${DEBUG}" ]; then
${PSQL} -dmal -v arg="${arg}" -f <(echo "SELECT $func(:'arg');")
else
${PSQL} -dmal -v arg="${arg}" -f <(echo "SELECT $func(:'arg');") \
2>&1 | sed 's/psql:\/dev\/fd\/[0-9]*:.: NOTICE: //'
fi
}
# Load the SQL code
${PSQL} -f $1
[ "${SKIP_INIT}" ] || ${PSQL} -f $1 >/dev/null
# Set the present working directory (for slurp)
# TODO: not "multiprocess" safe.
${PSQL} -dmal -c "SELECT env_vset(0, '*PWD*', READ('$(pwd)'));" >/dev/null
shift
if [ $# -gt 0 ]; then
args=$(for a in "$@"; do echo -n "\"$a\" "; done)
run RUN "(${args})"
exit 0
fi
[ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE}
while read -u 0 -r -e -p "user> " line; do
[ -z "${line}" ] && continue
history -s -- "${line}" # add to history
history -a ${RL_HISTORY_FILE} # save history to file
# Run a command
${PSQL} -dmal -v line="${line}" -f <(echo "SELECT REP(:'line');")
run REP "${line}"
done