From 5340418b47ec062856f61b274d4d00db750997fa Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Tue, 22 Mar 2016 00:53:31 -0500 Subject: [PATCH] plpgsql: steps 4-6. --- Makefile | 1 + plpgsql/Makefile | 27 +++ plpgsql/core.sql | 258 ++++++++++++++++++++++ plpgsql/env.sql | 102 ++++++--- plpgsql/printer.sql | 80 +++++-- plpgsql/reader.sql | 21 +- plpgsql/step2_eval.sql | 19 +- plpgsql/step3_env.sql | 9 +- plpgsql/step4_if_fn_do.sql | 196 +++++++++++++++++ plpgsql/step5_tco.sql | 204 ++++++++++++++++++ plpgsql/step6_file.sql | 227 ++++++++++++++++++++ plpgsql/types.sql | 426 ++++++++++++++++++++++++++++++++++--- plpgsql/wrap.sh | 34 ++- 13 files changed, 1494 insertions(+), 110 deletions(-) create mode 100644 plpgsql/Makefile create mode 100644 plpgsql/core.sql create mode 100644 plpgsql/step4_if_fn_do.sql create mode 100644 plpgsql/step5_tco.sql create mode 100644 plpgsql/step6_file.sql diff --git a/Makefile b/Makefile index 30e0ed2c..74e1c785 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/plpgsql/Makefile b/plpgsql/Makefile new file mode 100644 index 00000000..dc0d8d30 --- /dev/null +++ b/plpgsql/Makefile @@ -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]" + diff --git a/plpgsql/core.sql b/plpgsql/core.sql new file mode 100644 index 00000000..be72960c --- /dev/null +++ b/plpgsql/core.sql @@ -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')) + ; + diff --git a/plpgsql/env.sql b/plpgsql/env.sql index 95dc7ad6..f441ec42 100644 --- a/plpgsql/env.sql +++ b/plpgsql/env.sql @@ -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 diff --git a/plpgsql/printer.sql b/plpgsql/printer.sql index 5e91d238..1bba2c9d 100644 --- a/plpgsql/printer.sql +++ b/plpgsql/printer.sql @@ -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 + WHEN type = 11 THEN -- native function + RETURN '#'; + WHEN type = 12 THEN -- mal function BEGIN - RETURN '#'; + 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'; diff --git a/plpgsql/reader.sql b/plpgsql/reader.sql index efefbfb9..49334881 100644 --- a/plpgsql/reader.sql +++ b/plpgsql/reader.sql @@ -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; diff --git a/plpgsql/step2_eval.sql b/plpgsql/step2_eval.sql index 845ec80e..a923ca77 100644 --- a/plpgsql/step2_eval.sql +++ b/plpgsql/step2_eval.sql @@ -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 $$ diff --git a/plpgsql/step3_env.sql b/plpgsql/step3_env.sql index 2a7f8f3f..39177bae 100644 --- a/plpgsql/step3_env.sql +++ b/plpgsql/step3_env.sql @@ -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 $$ diff --git a/plpgsql/step4_if_fn_do.sql b/plpgsql/step4_if_fn_do.sql new file mode 100644 index 00000000..cc3b6a3f --- /dev/null +++ b/plpgsql/step4_if_fn_do.sql @@ -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' + diff --git a/plpgsql/step5_tco.sql b/plpgsql/step5_tco.sql new file mode 100644 index 00000000..ddefb967 --- /dev/null +++ b/plpgsql/step5_tco.sql @@ -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' + diff --git a/plpgsql/step6_file.sql b/plpgsql/step6_file.sql new file mode 100644 index 00000000..b5abe090 --- /dev/null +++ b/plpgsql/step6_file.sql @@ -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; + diff --git a/plpgsql/types.sql b/plpgsql/types.sql index 7086f961..5b06bac2 100644 --- a/plpgsql/types.sql +++ b/plpgsql/types.sql @@ -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 - INSERT INTO string (value) - VALUES (name) - RETURNING string_id INTO str_id; - -- Create symbol entry - INSERT INTO value (type_id, val_string_id) VALUES (7, str_id) - RETURNING value_id INTO result; + -- 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 (str) + RETURNING string_id INTO 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; - list_id integer; + 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; - list_id integer; + 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; - list_id integer; + 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; diff --git a/plpgsql/wrap.sh b/plpgsql/wrap.sh index 2ee41867..ea287347 100755 --- a/plpgsql/wrap.sh +++ b/plpgsql/wrap.sh @@ -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