mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 10:07:45 +03:00
plpgsql: IO using stream table. Add keywords.
This commit is contained in:
parent
c3a87f5174
commit
53105a7728
@ -1,4 +1,4 @@
|
|||||||
FROM sameersbn/postgresql
|
FROM sameersbn/postgresql:9.4-17
|
||||||
|
|
||||||
RUN apt-get -y update
|
RUN apt-get -y update
|
||||||
RUN apt-get -y install make cpp python
|
RUN apt-get -y install make cpp python
|
||||||
|
@ -10,9 +10,9 @@ INSERT INTO value (type_id, function_name) VALUES (11, 'mal_equal');
|
|||||||
CREATE OR REPLACE FUNCTION mal_throw(args integer[]) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION mal_throw(args integer[]) RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
-- TODO: Only throws strings. Without subtransactions, all changes
|
-- TODO: Only throws strings. Without subtransactions, all changes
|
||||||
-- to DB up to this point get rolled back so object being thrown
|
-- to DB up to this point get rolled back so the object being
|
||||||
-- dissapears.
|
-- thrown dissapears.
|
||||||
RAISE EXCEPTION '%', _vstring(pr_str(args[1]));
|
RAISE EXCEPTION '%', pr_str(args[1], false);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_throw');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_throw');
|
||||||
|
|
||||||
@ -49,6 +49,22 @@ BEGIN
|
|||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_symbol_Q');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_symbol_Q');
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION mal_keyword(args integer[]) RETURNS integer AS $$
|
||||||
|
BEGIN
|
||||||
|
IF _keyword_Q(args[1]) THEN
|
||||||
|
RETURN args[1];
|
||||||
|
ELSE
|
||||||
|
RETURN _keywordv(_vstring(args[1]));
|
||||||
|
END IF;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_keyword');
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION mal_keyword_Q(args integer[]) RETURNS integer AS $$
|
||||||
|
BEGIN
|
||||||
|
RETURN _wraptf(_keyword_Q(args[1]));
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_keyword_Q');
|
||||||
|
|
||||||
|
|
||||||
-- string functions
|
-- string functions
|
||||||
|
|
||||||
@ -66,14 +82,16 @@ INSERT INTO value (type_id, function_name) VALUES (11, 'mal_str');
|
|||||||
|
|
||||||
CREATE OR REPLACE FUNCTION mal_prn(args integer[]) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION mal_prn(args integer[]) RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RAISE NOTICE '%', pr_str_array(args, ' ', true);
|
--RAISE NOTICE '%', pr_str_array(args, ' ', true);
|
||||||
|
PERFORM writeline(pr_str_array(args, ' ', true));
|
||||||
RETURN 0; -- nil
|
RETURN 0; -- nil
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_prn');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_prn');
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION mal_println(args integer[]) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION mal_println(args integer[]) RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RAISE NOTICE '%', pr_str_array(args, ' ', false);
|
--RAISE NOTICE '%', pr_str_array(args, ' ', false);
|
||||||
|
PERFORM writeline(pr_str_array(args, ' ', false));
|
||||||
RETURN 0; -- nil
|
RETURN 0; -- nil
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_println');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_println');
|
||||||
@ -373,6 +391,8 @@ INSERT INTO env_data (env_id, key, value_id) VALUES
|
|||||||
(0, 'true?', (SELECT value_id FROM value WHERE function_name = 'mal_true_Q')),
|
(0, 'true?', (SELECT value_id FROM value WHERE function_name = 'mal_true_Q')),
|
||||||
(0, 'symbol', (SELECT value_id FROM value WHERE function_name = 'mal_symbol')),
|
(0, 'symbol', (SELECT value_id FROM value WHERE function_name = 'mal_symbol')),
|
||||||
(0, 'symbol?', (SELECT value_id FROM value WHERE function_name = 'mal_symbol_Q')),
|
(0, 'symbol?', (SELECT value_id FROM value WHERE function_name = 'mal_symbol_Q')),
|
||||||
|
(0, 'keyword', (SELECT value_id FROM value WHERE function_name = 'mal_keyword')),
|
||||||
|
(0, 'keyword?', (SELECT value_id FROM value WHERE function_name = 'mal_keyword_Q')),
|
||||||
|
|
||||||
(0, 'pr-str', (SELECT value_id FROM value WHERE function_name = 'mal_pr_str')),
|
(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, 'str', (SELECT value_id FROM value WHERE function_name = 'mal_str')),
|
||||||
|
117
plpgsql/io.sql
Normal file
117
plpgsql/io.sql
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
DROP EXTENSION IF EXISTS dblink;
|
||||||
|
CREATE EXTENSION dblink;
|
||||||
|
--SELECT dblink_connect('mal', 'dbname=mal');
|
||||||
|
|
||||||
|
DROP TABLE IF EXISTS stream;
|
||||||
|
CREATE TABLE stream (
|
||||||
|
stream_id integer,
|
||||||
|
data varchar,
|
||||||
|
rl_prompt varchar -- prompt for readline input
|
||||||
|
);
|
||||||
|
|
||||||
|
INSERT INTO stream (stream_id, data, rl_prompt) VALUES (0, '', ''); -- stdin
|
||||||
|
INSERT INTO stream (stream_id, data, rl_prompt) VALUES (1, '', ''); -- stdout
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION read(stream_id integer DEFAULT 0)
|
||||||
|
RETURNS varchar AS $$
|
||||||
|
DECLARE
|
||||||
|
query varchar;
|
||||||
|
input varchar;
|
||||||
|
sleep real = 0.05;
|
||||||
|
BEGIN
|
||||||
|
-- poll / wait for input
|
||||||
|
query := format('LOCK stream; UPDATE stream x SET data = '''' FROM (SELECT data FROM stream WHERE stream_id = %L AND data <> '''') y WHERE x.stream_id = %L AND x.data <> '''' RETURNING y.data AS cur_data;', stream_id, stream_id);
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
-- atomic get and set to empty
|
||||||
|
SELECT cur_data INTO input FROM dblink('dbname=mal', query)
|
||||||
|
AS t1(cur_data varchar);
|
||||||
|
--RAISE NOTICE 'read input: [%] %', input, stream_id;
|
||||||
|
IF input <> '' THEN
|
||||||
|
sleep := 0.05; -- reset sleep timer
|
||||||
|
--RAISE NOTICE 'read input: [%] %', input, stream_id;
|
||||||
|
--RETURN rtrim(input, E'\n');
|
||||||
|
RETURN input;
|
||||||
|
END IF;
|
||||||
|
--RAISE NOTICE 'sleeping 2 seconds';
|
||||||
|
--PERFORM pg_sleep(2);
|
||||||
|
PERFORM pg_sleep(sleep);
|
||||||
|
IF sleep < 0.5 THEN
|
||||||
|
sleep := sleep * 1.1; -- backoff
|
||||||
|
END IF;
|
||||||
|
END LOOP;
|
||||||
|
END;
|
||||||
|
$$ LANGUAGE 'plpgsql' STRICT;
|
||||||
|
|
||||||
|
-- readline:
|
||||||
|
-- set prompt and wait for readline style input on the stream
|
||||||
|
CREATE OR REPLACE FUNCTION readline(prompt varchar, stream_id integer DEFAULT 0)
|
||||||
|
RETURNS varchar AS $$
|
||||||
|
DECLARE
|
||||||
|
query varchar;
|
||||||
|
BEGIN
|
||||||
|
-- set prompt / request readline style input
|
||||||
|
query := format('LOCK stream; UPDATE stream SET rl_prompt = %L', prompt);
|
||||||
|
PERFORM dblink('dbname=mal', query);
|
||||||
|
|
||||||
|
RETURN read(stream_id);
|
||||||
|
END;
|
||||||
|
$$ LANGUAGE 'plpgsql' STRICT;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION write(data varchar, stream_id integer DEFAULT 1)
|
||||||
|
RETURNS void AS $$
|
||||||
|
DECLARE
|
||||||
|
query varchar;
|
||||||
|
BEGIN
|
||||||
|
query := format('LOCK stream; UPDATE stream SET data = data || %L WHERE stream_id = %L',
|
||||||
|
data, stream_id);
|
||||||
|
--RAISE NOTICE 'write query: %', query;
|
||||||
|
PERFORM dblink('dbname=mal', query);
|
||||||
|
END;
|
||||||
|
$$ LANGUAGE 'plpgsql' STRICT;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION writeline(data varchar, stream_id integer DEFAULT 1)
|
||||||
|
RETURNS void AS $$
|
||||||
|
BEGIN
|
||||||
|
PERFORM write(data || E'\n', stream_id);
|
||||||
|
END;
|
||||||
|
$$ LANGUAGE 'plpgsql' STRICT;
|
||||||
|
|
||||||
|
-- wait_rl_prompt:
|
||||||
|
-- wait for rl_prompt to be set on the given stream and return the
|
||||||
|
-- rl_prompt value
|
||||||
|
CREATE OR REPLACE FUNCTION wait_rl_prompt(stream_id integer DEFAULT 0)
|
||||||
|
RETURNS varchar AS $$
|
||||||
|
DECLARE
|
||||||
|
dquery varchar;
|
||||||
|
pending integer;
|
||||||
|
query varchar;
|
||||||
|
prompt varchar;
|
||||||
|
sleep real = 0.05;
|
||||||
|
BEGIN
|
||||||
|
-- make sure no data is pending on any stream
|
||||||
|
dquery := format('SELECT count(data) FROM stream WHERE data <> ''''');
|
||||||
|
-- wait for readline style input to be requested
|
||||||
|
--query := format('SELECT rl_prompt FROM stream WHERE stream_id = %L AND rl_prompt <> ''''', stream_id);
|
||||||
|
query := format('LOCK stream; UPDATE stream x SET rl_prompt = '''' FROM (SELECT rl_prompt FROM stream WHERE stream_id = %L AND rl_prompt <> '''') y WHERE x.stream_id = %L AND x.rl_prompt <> '''' RETURNING y.rl_prompt AS rl_prompt', stream_id, stream_id);
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
SELECT p INTO pending FROM dblink('dbname=mal', dquery)
|
||||||
|
AS t1(p integer);
|
||||||
|
IF pending = 0 THEN
|
||||||
|
-- atomic get and set to empty
|
||||||
|
SELECT rl_prompt INTO prompt FROM dblink('dbname=mal', query)
|
||||||
|
AS t1(rl_prompt varchar);
|
||||||
|
IF prompt <> '' THEN
|
||||||
|
sleep := 0.05; -- reset sleep timer
|
||||||
|
RETURN prompt;
|
||||||
|
END IF;
|
||||||
|
END IF;
|
||||||
|
PERFORM pg_sleep(sleep);
|
||||||
|
IF sleep < 0.5 THEN
|
||||||
|
sleep := sleep * 1.1; -- backoff
|
||||||
|
END IF;
|
||||||
|
END LOOP;
|
||||||
|
END;
|
||||||
|
$$ LANGUAGE 'plpgsql' STRICT;
|
||||||
|
|
@ -42,7 +42,9 @@ BEGIN
|
|||||||
FROM value WHERE value_id = ast) as varchar);
|
FROM value WHERE value_id = ast) as varchar);
|
||||||
WHEN type = 5 THEN -- string
|
WHEN type = 5 THEN -- string
|
||||||
str := _vstring(ast);
|
str := _vstring(ast);
|
||||||
IF print_readably THEN
|
IF chr(CAST(x'29e' AS integer)) = substring(str FROM 1 FOR 1) THEN
|
||||||
|
RETURN ':' || substring(str FROM 2 FOR (char_length(str)-1));
|
||||||
|
ELSIF print_readably THEN
|
||||||
str := replace(str, E'\\', '\\');
|
str := replace(str, E'\\', '\\');
|
||||||
str := replace(str, '"', '\"');
|
str := replace(str, '"', '\"');
|
||||||
str := replace(str, E'\n', '\n');
|
str := replace(str, E'\n', '\n');
|
||||||
@ -72,6 +74,17 @@ BEGIN
|
|||||||
WHERE c.collection_id = cid), ' ') ||
|
WHERE c.collection_id = cid), ' ') ||
|
||||||
']';
|
']';
|
||||||
END;
|
END;
|
||||||
|
WHEN type = 10 THEN -- hash-map
|
||||||
|
BEGIN
|
||||||
|
cid := (SELECT collection_id FROM value WHERE value_id = ast);
|
||||||
|
RETURN '{' ||
|
||||||
|
array_to_string(array(
|
||||||
|
SELECT pr_str(_stringv(c.key_string), print_readably) ||
|
||||||
|
' ' || pr_str(c.value_id, print_readably)
|
||||||
|
FROM collection c
|
||||||
|
WHERE c.collection_id = cid), ' ') ||
|
||||||
|
'}';
|
||||||
|
END;
|
||||||
WHEN type = 11 THEN -- native function
|
WHEN type = 11 THEN -- native function
|
||||||
RETURN '#<function ' ||
|
RETURN '#<function ' ||
|
||||||
(SELECT function_name FROM value WHERE value_id = ast) ||
|
(SELECT function_name FROM value WHERE value_id = ast) ||
|
||||||
|
@ -24,40 +24,46 @@ BEGIN
|
|||||||
token := tokens[pos];
|
token := tokens[pos];
|
||||||
pos := pos + 1;
|
pos := pos + 1;
|
||||||
-- RAISE NOTICE 'read_atom: %', token;
|
-- RAISE NOTICE 'read_atom: %', token;
|
||||||
IF token = 'nil' THEN
|
IF token = 'nil' THEN -- nil
|
||||||
result := 0;
|
result := 0;
|
||||||
ELSIF token = 'false' THEN
|
ELSIF token = 'false' THEN -- false
|
||||||
result := 1;
|
result := 1;
|
||||||
ELSIF token = 'true' THEN
|
ELSIF token = 'true' THEN -- true
|
||||||
result := 2;
|
result := 2;
|
||||||
ELSIF token ~ '^-?[0-9][0-9]*$' THEN
|
ELSIF token ~ '^-?[0-9][0-9]*$' THEN -- integer
|
||||||
-- integer
|
-- integer
|
||||||
INSERT INTO value (type_id, val_int)
|
INSERT INTO value (type_id, val_int)
|
||||||
VALUES (3, CAST(token AS integer))
|
VALUES (3, CAST(token AS integer))
|
||||||
RETURNING value_id INTO result;
|
RETURNING value_id INTO result;
|
||||||
ELSIF token ~ '^".*"' THEN
|
ELSIF token ~ '^".*"' THEN -- string
|
||||||
-- string
|
-- string
|
||||||
str := substring(token FROM 2 FOR (char_length(token)-2));
|
str := substring(token FROM 2 FOR (char_length(token)-2));
|
||||||
str := replace(str, '\"', '"');
|
str := replace(str, '\"', '"');
|
||||||
str := replace(str, '\n', E'\n');
|
str := replace(str, '\n', E'\n');
|
||||||
str := replace(str, '\\', E'\\');
|
str := replace(str, '\\', E'\\');
|
||||||
result := _stringv(str);
|
result := _stringv(str);
|
||||||
|
ELSIF token ~ '^:.*' THEN -- keyword
|
||||||
|
-- keyword
|
||||||
|
result := _keywordv(substring(token FROM 2 FOR (char_length(token)-1)));
|
||||||
ELSE
|
ELSE
|
||||||
-- symbol
|
-- symbol
|
||||||
result := _symbolv(token);
|
result := _symbolv(token);
|
||||||
END IF;
|
END IF;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- read_seq:
|
-- read_coll:
|
||||||
-- takes a tokens array, type (8,9), first and last characters and position
|
-- takes a tokens array, type (8, 9, 10), first and last characters
|
||||||
-- returns new position and value_id (or a list)
|
-- and position
|
||||||
|
-- returns new position and value_id for a list (8), vector (9) or
|
||||||
|
-- hash-map (10)
|
||||||
CREATE OR REPLACE FUNCTION
|
CREATE OR REPLACE FUNCTION
|
||||||
read_seq(tokens varchar[], type integer, first varchar, last varchar,
|
read_coll(tokens varchar[], type integer, first varchar, last varchar,
|
||||||
INOUT pos integer, OUT result integer) AS $$
|
INOUT pos integer, OUT result integer) AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
list_id integer = NULL;
|
coll_id integer = NULL;
|
||||||
token varchar;
|
token varchar;
|
||||||
idx integer = 0;
|
idx integer = 0;
|
||||||
|
key varchar = NULL;
|
||||||
item_id integer;
|
item_id integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
token := tokens[pos];
|
token := tokens[pos];
|
||||||
@ -66,23 +72,38 @@ BEGIN
|
|||||||
RAISE EXCEPTION 'expected ''%''', first;
|
RAISE EXCEPTION 'expected ''%''', first;
|
||||||
END IF;
|
END IF;
|
||||||
LOOP
|
LOOP
|
||||||
|
IF type = 10 THEN -- hashmap
|
||||||
|
-- key for hash-map
|
||||||
|
IF pos > array_length(tokens, 1) THEN
|
||||||
|
RAISE EXCEPTION 'expected ''%''', last;
|
||||||
|
END IF;
|
||||||
|
token := tokens[pos];
|
||||||
|
IF token = last THEN EXIT; END IF;
|
||||||
|
SELECT * FROM read_form(tokens, pos) INTO pos, item_id;
|
||||||
|
|
||||||
|
SELECT val_string FROM value INTO key WHERE value_id = item_id;
|
||||||
|
END IF;
|
||||||
|
|
||||||
IF pos > array_length(tokens, 1) THEN
|
IF pos > array_length(tokens, 1) THEN
|
||||||
RAISE EXCEPTION 'expected ''%''', last;
|
RAISE EXCEPTION 'expected ''%''', last;
|
||||||
END IF;
|
END IF;
|
||||||
token := tokens[pos];
|
token := tokens[pos];
|
||||||
IF token = last THEN EXIT; END IF;
|
IF token = last THEN EXIT; END IF;
|
||||||
SELECT * FROM read_form(tokens, pos) INTO pos, item_id;
|
SELECT * FROM read_form(tokens, pos) INTO pos, item_id;
|
||||||
IF list_id IS NULL THEN
|
|
||||||
list_id := (SELECT COALESCE(Max(collection_id), 0) FROM collection)+1;
|
IF coll_id IS NULL THEN
|
||||||
|
coll_id := (SELECT COALESCE(Max(collection_id), 0) FROM collection)+1;
|
||||||
END IF;
|
END IF;
|
||||||
INSERT INTO collection (collection_id, idx, value_id)
|
|
||||||
VALUES (list_id, idx, item_id);
|
-- value for list, vector and hash-map
|
||||||
|
INSERT INTO collection (collection_id, idx, key_string, value_id)
|
||||||
|
VALUES (coll_id, idx, key, item_id);
|
||||||
idx := idx + 1;
|
idx := idx + 1;
|
||||||
END LOOP;
|
END LOOP;
|
||||||
|
|
||||||
-- Create new list referencing list_id
|
-- Create new list referencing coll_id
|
||||||
INSERT INTO value (type_id, collection_id)
|
INSERT INTO value (type_id, collection_id)
|
||||||
VALUES (type, list_id)
|
VALUES (type, coll_id)
|
||||||
RETURNING value_id INTO result;
|
RETURNING value_id INTO result;
|
||||||
pos := pos + 1;
|
pos := pos + 1;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -142,7 +163,7 @@ BEGIN
|
|||||||
RAISE EXCEPTION 'unexpected '')''';
|
RAISE EXCEPTION 'unexpected '')''';
|
||||||
WHEN token = '(' THEN
|
WHEN token = '(' THEN
|
||||||
BEGIN
|
BEGIN
|
||||||
SELECT * FROM read_seq(tokens, 8, '(', ')', pos) INTO pos, result;
|
SELECT * FROM read_coll(tokens, 8, '(', ')', pos) INTO pos, result;
|
||||||
END;
|
END;
|
||||||
|
|
||||||
-- vector
|
-- vector
|
||||||
@ -150,7 +171,15 @@ BEGIN
|
|||||||
RAISE EXCEPTION 'unexpected '']''';
|
RAISE EXCEPTION 'unexpected '']''';
|
||||||
WHEN token = '[' THEN
|
WHEN token = '[' THEN
|
||||||
BEGIN
|
BEGIN
|
||||||
SELECT * FROM read_seq(tokens, 9, '[', ']', pos) INTO pos, result;
|
SELECT * FROM read_coll(tokens, 9, '[', ']', pos) INTO pos, result;
|
||||||
|
END;
|
||||||
|
|
||||||
|
-- hash-map
|
||||||
|
WHEN token = '}' THEN
|
||||||
|
RAISE EXCEPTION 'unexpected ''}''';
|
||||||
|
WHEN token = '{' THEN
|
||||||
|
BEGIN
|
||||||
|
SELECT * FROM read_coll(tokens, 10, '{', '}', pos) INTO pos, result;
|
||||||
END;
|
END;
|
||||||
|
|
||||||
--
|
--
|
||||||
|
@ -1,23 +1,26 @@
|
|||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
|
|
||||||
-- ---------------------------------------------------------
|
-- ---------------------------------------------------------
|
||||||
-- step0_repl.sql.in
|
-- step0_repl.sql.in
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS varchar
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
AS $$
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN line;
|
RETURN line;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast varchar, env varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast varchar, env varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN ast;
|
RETURN ast;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- print
|
-- print
|
||||||
CREATE OR REPLACE FUNCTION PRINT(exp varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION PRINT(exp varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN exp;
|
RETURN exp;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -27,15 +30,35 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- stub to support wrap.sh
|
-- stub to support wrap.sh
|
||||||
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val varchar)
|
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val varchar)
|
||||||
RETURNS void AS $$
|
RETURNS void AS $$
|
||||||
BEGIN END; $$ LANGUAGE plpgsql;
|
|
||||||
|
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
|
||||||
DECLARE
|
|
||||||
output varchar;
|
|
||||||
BEGIN
|
BEGIN
|
||||||
-- RAISE NOTICE 'line is %', line;
|
END; $$ LANGUAGE plpgsql;
|
||||||
-- output := 'line: ' || line;
|
|
||||||
RETURN line;
|
|
||||||
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
|
BEGIN
|
||||||
|
RETURN PRINT(EVAL(READ(line), ''));
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -7,19 +8,22 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN ast;
|
RETURN ast;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- print
|
-- print
|
||||||
CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION PRINT(exp integer)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN pr_str(exp);
|
RETURN pr_str(exp);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -29,15 +33,35 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- stub to support wrap.sh
|
-- stub to support wrap.sh
|
||||||
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
|
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
|
||||||
RETURNS void AS $$
|
RETURNS void AS $$
|
||||||
BEGIN END; $$ LANGUAGE plpgsql;
|
BEGIN
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
|
||||||
DECLARE
|
|
||||||
output varchar;
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
-- RAISE NOTICE 'line is %', line;
|
|
||||||
-- output := 'line: ' || line;
|
|
||||||
RETURN PRINT(EVAL(READ(line), ''));
|
RETURN PRINT(EVAL(READ(line), ''));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -7,13 +8,15 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -63,7 +66,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
el integer;
|
el integer;
|
||||||
@ -86,7 +90,8 @@ BEGIN
|
|||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- print
|
-- print
|
||||||
CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION PRINT(exp integer)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN pr_str(exp);
|
RETURN pr_str(exp);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -102,13 +107,14 @@ CREATE TABLE env (
|
|||||||
);
|
);
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
|
CREATE OR REPLACE FUNCTION env_vset(env integer, name varchar, val integer)
|
||||||
RETURNS void AS $$
|
RETURNS void AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
INSERT INTO env (env_id, key, value_id) VALUES (env, name, val);
|
INSERT INTO env (env_id, key, value_id) VALUES (env, name, val);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION mal_intop(op varchar, args integer[]) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION mal_intop(op varchar, args integer[])
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE a integer; b integer; result integer;
|
DECLARE a integer; b integer; result integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
SELECT val_int INTO a FROM value WHERE value_id = args[1];
|
SELECT val_int INTO a FROM value WHERE value_id = args[1];
|
||||||
@ -139,11 +145,30 @@ SELECT env_vset(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_m
|
|||||||
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
|
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
|
||||||
|
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
DECLARE
|
RETURNS varchar AS $$
|
||||||
output varchar;
|
|
||||||
BEGIN
|
BEGIN
|
||||||
-- RAISE NOTICE 'line is %', line;
|
|
||||||
-- output := 'line: ' || line;
|
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -10,13 +9,15 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -60,7 +61,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -81,9 +83,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -161,7 +161,7 @@ INSERT INTO value (type_id, function_name) VALUES (11, 'mal_subtract');
|
|||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_multiply');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_multiply');
|
||||||
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_divide');
|
INSERT INTO value (type_id, function_name) VALUES (11, 'mal_divide');
|
||||||
|
|
||||||
-- -- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
INSERT INTO env (env_id, outer_id) VALUES (0, NULL);
|
INSERT INTO env (env_id, outer_id) VALUES (0, NULL);
|
||||||
|
|
||||||
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_add'));
|
||||||
@ -170,11 +170,30 @@ SELECT env_vset(0, '*', (SELECT value_id FROM value WHERE function_name = 'mal_m
|
|||||||
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
|
SELECT env_vset(0, '/', (SELECT value_id FROM value WHERE function_name = 'mal_divide'));
|
||||||
|
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
DECLARE
|
RETURNS varchar AS $$
|
||||||
output varchar;
|
|
||||||
BEGIN
|
BEGIN
|
||||||
-- RAISE NOTICE 'line is %', line;
|
|
||||||
-- output := 'line: ' || line;
|
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,13 +10,15 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -61,7 +62,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -88,9 +90,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -180,7 +180,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -191,3 +192,24 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
-- core.mal: defined using the language itself
|
-- core.mal: defined using the language itself
|
||||||
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,13 +10,15 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -61,7 +62,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -89,9 +91,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -188,7 +188,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -199,3 +200,24 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
-- core.mal: defined using the language itself
|
-- core.mal: defined using the language itself
|
||||||
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,13 +10,15 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- eval
|
-- eval
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -61,7 +62,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -89,9 +91,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -188,7 +188,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -212,7 +213,30 @@ SELECT env_vset(0, '*ARGV*', READ('()'));
|
|||||||
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
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'
|
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 $$
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION RUN(argstring varchar)
|
||||||
|
RETURNS void AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
allargs integer;
|
allargs integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,7 +10,8 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -47,7 +47,8 @@ BEGIN
|
|||||||
END IF;
|
END IF;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -91,7 +92,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -119,9 +121,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -227,7 +227,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -251,7 +252,30 @@ SELECT env_vset(0, '*ARGV*', READ('()'));
|
|||||||
SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
|
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'
|
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 $$
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION RUN(argstring varchar)
|
||||||
|
RETURNS void AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
allargs integer;
|
allargs integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,7 +10,8 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -80,7 +80,7 @@ BEGIN
|
|||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
RETURNS integer AS $$
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -124,7 +124,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -158,9 +159,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -276,7 +275,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -302,7 +302,30 @@ SELECT REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")
|
|||||||
SELECT REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null'
|
SELECT REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null'
|
||||||
SELECT REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))') \g '/dev/null'
|
SELECT REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))') \g '/dev/null'
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION RUN(argstring varchar) RETURNS void AS $$
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION RUN(argstring varchar)
|
||||||
|
RETURNS void AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
allargs integer;
|
allargs integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
\set VERBOSITY 'terse'
|
|
||||||
|
|
||||||
\i init.sql
|
\i init.sql
|
||||||
|
\i io.sql
|
||||||
\i types.sql
|
\i types.sql
|
||||||
\i reader.sql
|
\i reader.sql
|
||||||
\i printer.sql
|
\i printer.sql
|
||||||
@ -11,7 +10,8 @@
|
|||||||
-- step1_read_print.sql
|
-- step1_read_print.sql
|
||||||
|
|
||||||
-- read
|
-- read
|
||||||
CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION READ(line varchar)
|
||||||
|
RETURNS integer AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN read_str(line);
|
RETURN read_str(line);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -80,7 +80,7 @@ BEGIN
|
|||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer)
|
||||||
RETURNS integer AS $$
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
symkey varchar;
|
symkey varchar;
|
||||||
@ -124,7 +124,8 @@ BEGIN
|
|||||||
RETURN result;
|
RETURN result;
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
|
CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer)
|
||||||
|
RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
type integer;
|
type integer;
|
||||||
a0 integer;
|
a0 integer;
|
||||||
@ -159,9 +160,7 @@ BEGIN
|
|||||||
|
|
||||||
a0 := _first(ast);
|
a0 := _first(ast);
|
||||||
IF _symbol_Q(a0) THEN
|
IF _symbol_Q(a0) THEN
|
||||||
a0sym := (SELECT string.value FROM string
|
a0sym := (SELECT val_string FROM value WHERE value_id = a0);
|
||||||
INNER JOIN value ON value.val_string_id=string.string_id
|
|
||||||
WHERE value.value_id = a0);
|
|
||||||
ELSE
|
ELSE
|
||||||
a0sym := '__<*fn*>__';
|
a0sym := '__<*fn*>__';
|
||||||
END IF;
|
END IF;
|
||||||
@ -294,7 +293,8 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
|
|
||||||
-- repl_env is environment 0
|
-- repl_env is environment 0
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
|
CREATE OR REPLACE FUNCTION REP(line varchar)
|
||||||
|
RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN PRINT(EVAL(READ(line), 0));
|
RETURN PRINT(EVAL(READ(line), 0));
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
@ -320,7 +320,30 @@ SELECT REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")
|
|||||||
SELECT REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null'
|
SELECT REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))') \g '/dev/null'
|
||||||
SELECT REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))') \g '/dev/null'
|
SELECT REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))') \g '/dev/null'
|
||||||
|
|
||||||
CREATE OR REPLACE FUNCTION RUN(argstring varchar) RETURNS void AS $$
|
CREATE OR REPLACE FUNCTION MAIN_LOOP()
|
||||||
|
RETURNS integer AS $$
|
||||||
|
DECLARE
|
||||||
|
line varchar;
|
||||||
|
output varchar;
|
||||||
|
BEGIN
|
||||||
|
WHILE true
|
||||||
|
LOOP
|
||||||
|
BEGIN
|
||||||
|
line := readline('user> ', 0);
|
||||||
|
IF line IS NULL THEN RETURN 0; END IF;
|
||||||
|
IF line <> '' THEN
|
||||||
|
output := REP(line);
|
||||||
|
PERFORM writeline(output);
|
||||||
|
END IF;
|
||||||
|
|
||||||
|
EXCEPTION WHEN OTHERS THEN
|
||||||
|
PERFORM writeline('Error: ' || SQLERRM);
|
||||||
|
END;
|
||||||
|
END LOOP;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
CREATE OR REPLACE FUNCTION RUN(argstring varchar)
|
||||||
|
RETURNS void AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
allargs integer;
|
allargs integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
|
@ -14,7 +14,7 @@ INSERT INTO type VALUES (2, 'true');
|
|||||||
INSERT INTO type VALUES (3, 'integer');
|
INSERT INTO type VALUES (3, 'integer');
|
||||||
INSERT INTO type VALUES (4, 'float');
|
INSERT INTO type VALUES (4, 'float');
|
||||||
INSERT INTO type VALUES (5, 'string');
|
INSERT INTO type VALUES (5, 'string');
|
||||||
INSERT INTO type VALUES (6, 'keyword');
|
--INSERT INTO type VALUES (6, 'keyword');
|
||||||
INSERT INTO type VALUES (7, 'symbol');
|
INSERT INTO type VALUES (7, 'symbol');
|
||||||
INSERT INTO type VALUES (8, 'list');
|
INSERT INTO type VALUES (8, 'list');
|
||||||
INSERT INTO type VALUES (9, 'vector');
|
INSERT INTO type VALUES (9, 'vector');
|
||||||
@ -24,37 +24,24 @@ INSERT INTO type VALUES (12, 'malfunc');
|
|||||||
INSERT INTO type VALUES (13, 'atom');
|
INSERT INTO type VALUES (13, 'atom');
|
||||||
|
|
||||||
|
|
||||||
-- string values ("interned")
|
-- ---------------------------------------------------------
|
||||||
|
|
||||||
CREATE SEQUENCE string_id_seq;
|
|
||||||
CREATE TABLE string (
|
|
||||||
string_id integer NOT NULL DEFAULT nextval('string_id_seq'),
|
|
||||||
value varchar(4096)
|
|
||||||
);
|
|
||||||
ALTER TABLE string ADD CONSTRAINT pk_string_id
|
|
||||||
PRIMARY KEY (string_id);
|
|
||||||
-- drop sequence when table dropped
|
|
||||||
ALTER SEQUENCE string_id_seq OWNED BY string.string_id;
|
|
||||||
|
|
||||||
|
|
||||||
-- collections/groupings
|
-- collections/groupings
|
||||||
|
|
||||||
CREATE TABLE collection (
|
CREATE TABLE collection (
|
||||||
collection_id integer NOT NULL, -- same for items of a collection
|
collection_id integer NOT NULL, -- same for items of a collection
|
||||||
idx integer, -- set for list and vector items
|
idx integer, -- set for list and vector items
|
||||||
key_string_id integer, -- set for hashmap items
|
key_string varchar, -- set for hashmap items
|
||||||
value_id integer, -- set for all items (ast for functions)
|
value_id integer, -- set for all items (ast for functions)
|
||||||
params_id integer, -- set for functions
|
params_id integer, -- set for functions
|
||||||
env_id integer, -- set for functions
|
env_id integer, -- set for functions
|
||||||
macro boolean -- set for macro functions
|
macro boolean -- set for macro functions
|
||||||
);
|
);
|
||||||
-- ALTER TABLE collection ADD CONSTRAINT pk_collection
|
-- ALTER TABLE collection ADD CONSTRAINT pk_collection
|
||||||
-- PRIMARY KEY (collection_id, idx, key_string_id);
|
-- PRIMARY KEY (collection_id, idx, key_string);
|
||||||
ALTER TABLE collection ADD CONSTRAINT fk_key_string_id
|
|
||||||
FOREIGN KEY (key_string_id) REFERENCES string(string_id);
|
|
||||||
-- value_id, params_id foreign keys are after value table
|
-- value_id, params_id foreign keys are after value table
|
||||||
|
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------
|
||||||
-- persistent values
|
-- persistent values
|
||||||
|
|
||||||
CREATE SEQUENCE value_id_seq START WITH 3; -- skip nil, false, true
|
CREATE SEQUENCE value_id_seq START WITH 3; -- skip nil, false, true
|
||||||
@ -62,7 +49,7 @@ CREATE TABLE value (
|
|||||||
value_id integer NOT NULL DEFAULT nextval('value_id_seq'),
|
value_id integer NOT NULL DEFAULT nextval('value_id_seq'),
|
||||||
type_id integer NOT NULL,
|
type_id integer NOT NULL,
|
||||||
val_int integer, -- set for integers
|
val_int integer, -- set for integers
|
||||||
val_string_id integer, -- set for strings, keywords, and symbols
|
val_string varchar, -- set for strings, keywords, and symbols
|
||||||
collection_id integer, -- set for lists, vectors and hashmaps
|
collection_id integer, -- set for lists, vectors and hashmaps
|
||||||
-- (NULL for empty collection)
|
-- (NULL for empty collection)
|
||||||
function_name varchar -- set for native function types
|
function_name varchar -- set for native function types
|
||||||
@ -73,10 +60,8 @@ ALTER TABLE value ADD CONSTRAINT pk_value_id
|
|||||||
ALTER SEQUENCE value_id_seq OWNED BY value.value_id;
|
ALTER SEQUENCE value_id_seq OWNED BY value.value_id;
|
||||||
ALTER TABLE value ADD CONSTRAINT fk_type_id
|
ALTER TABLE value ADD CONSTRAINT fk_type_id
|
||||||
FOREIGN KEY (type_id) REFERENCES type(type_id);
|
FOREIGN KEY (type_id) REFERENCES type(type_id);
|
||||||
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
|
-- ALTER TABLE value ADD CONSTRAINT fk_collection_id
|
||||||
-- FOREIGN KEY (collection_id) REFERENCES collection(collection_id, idx, key_string_id);
|
-- FOREIGN KEY (collection_id) REFERENCES collection(collection_id, idx, key_string);
|
||||||
-- References from collection back to value
|
-- References from collection back to value
|
||||||
ALTER TABLE collection ADD CONSTRAINT fk_value_id
|
ALTER TABLE collection ADD CONSTRAINT fk_value_id
|
||||||
FOREIGN KEY (value_id) REFERENCES value(value_id);
|
FOREIGN KEY (value_id) REFERENCES value(value_id);
|
||||||
@ -170,8 +155,8 @@ BEGIN
|
|||||||
|
|
||||||
-- copy collection and change collection_id
|
-- copy collection and change collection_id
|
||||||
INSERT INTO collection
|
INSERT INTO collection
|
||||||
(collection_id,idx,key_string_id,value_id,params_id,env_id,macro)
|
(collection_id,idx,key_string,value_id,params_id,env_id,macro)
|
||||||
(SELECT dst_coll_id,idx,key_string_id,value_id,params_id,env_id,macro
|
(SELECT dst_coll_id,idx,key_string,value_id,params_id,env_id,macro
|
||||||
FROM collection
|
FROM collection
|
||||||
WHERE collection_id = src_coll_id);
|
WHERE collection_id = src_coll_id);
|
||||||
|
|
||||||
@ -222,9 +207,7 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
CREATE OR REPLACE FUNCTION
|
CREATE OR REPLACE FUNCTION
|
||||||
_vstring(sid integer) RETURNS varchar AS $$
|
_vstring(sid integer) RETURNS varchar AS $$
|
||||||
BEGIN
|
BEGIN
|
||||||
RETURN (SELECT value FROM string
|
RETURN (SELECT val_string FROM value WHERE value_id = sid);
|
||||||
WHERE string_id = (SELECT val_string_id
|
|
||||||
FROM value WHERE value_id = sid));
|
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- _stringish:
|
-- _stringish:
|
||||||
@ -233,22 +216,16 @@ END; $$ LANGUAGE plpgsql;
|
|||||||
CREATE OR REPLACE FUNCTION
|
CREATE OR REPLACE FUNCTION
|
||||||
_stringish(str varchar, type integer) RETURNS integer AS $$
|
_stringish(str varchar, type integer) RETURNS integer AS $$
|
||||||
DECLARE
|
DECLARE
|
||||||
str_id integer;
|
|
||||||
result integer;
|
result integer;
|
||||||
BEGIN
|
BEGIN
|
||||||
-- TODO: share string data between string types
|
-- TODO: share string data between string types
|
||||||
-- lookup if it exists
|
-- lookup if it exists
|
||||||
SELECT value_id FROM value INTO result
|
SELECT value_id FROM value INTO result
|
||||||
INNER JOIN string ON value.val_string_id=string.string_id
|
WHERE val_string = str AND type_id = type;
|
||||||
WHERE string.value = str AND value.type_id = type;
|
|
||||||
IF result IS NULL THEN
|
IF result IS NULL THEN
|
||||||
-- Create string value for string
|
-- Create string entry
|
||||||
INSERT INTO string (value)
|
INSERT INTO value (type_id, val_string)
|
||||||
VALUES (str)
|
VALUES (type, 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;
|
RETURNING value_id INTO result;
|
||||||
END IF;
|
END IF;
|
||||||
RETURN result;
|
RETURN result;
|
||||||
@ -263,6 +240,33 @@ BEGIN
|
|||||||
RETURN _stringish(str, 5);
|
RETURN _stringish(str, 5);
|
||||||
END; $$ LANGUAGE plpgsql;
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
-- _keywordv:
|
||||||
|
-- takes a varchar string
|
||||||
|
-- returns the value_id of a keyword (new or existing)
|
||||||
|
CREATE OR REPLACE FUNCTION
|
||||||
|
_keywordv(name varchar) RETURNS integer AS $$
|
||||||
|
BEGIN
|
||||||
|
RETURN _stringish(chr(CAST(x'29e' AS integer)) || name, 5);
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
|
-- _keyword_Q:
|
||||||
|
-- takes a value_id
|
||||||
|
-- returns the whether value_id is keyword type
|
||||||
|
CREATE OR REPLACE FUNCTION
|
||||||
|
_keyword_Q(id integer) RETURNS boolean AS $$
|
||||||
|
DECLARE
|
||||||
|
str varchar;
|
||||||
|
BEGIN
|
||||||
|
IF (SELECT 1 FROM value WHERE type_id = 5 AND value_id = id) THEN
|
||||||
|
str := _vstring(id);
|
||||||
|
IF char_length(str) > 0 AND
|
||||||
|
chr(CAST(x'29e' AS integer)) = substring(str FROM 1 FOR 1) THEN
|
||||||
|
RETURN true;
|
||||||
|
END IF;
|
||||||
|
END IF;
|
||||||
|
RETURN false;
|
||||||
|
END; $$ LANGUAGE plpgsql;
|
||||||
|
|
||||||
-- _symbolv:
|
-- _symbolv:
|
||||||
-- takes a varchar string
|
-- takes a varchar string
|
||||||
-- returns the value_id of a symbol (new or existing)
|
-- returns the value_id of a symbol (new or existing)
|
||||||
|
@ -5,19 +5,18 @@ set -e
|
|||||||
RL_HISTORY_FILE=${HOME}/.mal-history
|
RL_HISTORY_FILE=${HOME}/.mal-history
|
||||||
SKIP_INIT="${SKIP_INIT:-}"
|
SKIP_INIT="${SKIP_INIT:-}"
|
||||||
PSQL="psql -q -t -A -v ON_ERROR_STOP=1"
|
PSQL="psql -q -t -A -v ON_ERROR_STOP=1"
|
||||||
|
|
||||||
[ "${DEBUG}" ] || PSQL="${PSQL} -v VERBOSITY=terse"
|
[ "${DEBUG}" ] || PSQL="${PSQL} -v VERBOSITY=terse"
|
||||||
|
|
||||||
# Run a command
|
MAIN_PID=
|
||||||
run() {
|
STDOUT_PID=
|
||||||
local func=$1 arg=$2
|
|
||||||
if [ "${DEBUG}" ]; then
|
cleanup() {
|
||||||
${PSQL} -dmal -v arg="${arg}" -f <(echo "SELECT $func(:'arg');")
|
echo "cleanup"
|
||||||
else
|
trap - TERM QUIT INT EXIT
|
||||||
${PSQL} -dmal -v arg="${arg}" -f <(echo "SELECT $func(:'arg');") \
|
[ "${MAIN_PID}" ] && kill ${MAIN_PID}
|
||||||
2>&1 | sed 's/psql:\/dev\/fd\/[0-9]*:.: NOTICE: //'
|
[ "${STDOUT_PID}" ] && kill ${STDOUT_PID}
|
||||||
fi
|
|
||||||
}
|
}
|
||||||
|
trap "cleanup" TERM QUIT INT EXIT
|
||||||
|
|
||||||
# Load the SQL code
|
# Load the SQL code
|
||||||
[ "${SKIP_INIT}" ] || ${PSQL} -f $1 >/dev/null
|
[ "${SKIP_INIT}" ] || ${PSQL} -f $1 >/dev/null
|
||||||
@ -29,16 +28,40 @@ ${PSQL} -dmal -c "SELECT env_vset(0, '*PWD*', READ('$(pwd)'));" >/dev/null
|
|||||||
shift
|
shift
|
||||||
if [ $# -gt 0 ]; then
|
if [ $# -gt 0 ]; then
|
||||||
args=$(for a in "$@"; do echo -n "\"$a\" "; done)
|
args=$(for a in "$@"; do echo -n "\"$a\" "; done)
|
||||||
run RUN "(${args})"
|
${PSQL} -dmal -v arg1="(${args})" -f <(echo "SELECT RUN(:'arg1');")
|
||||||
exit 0
|
exit 0
|
||||||
fi
|
fi
|
||||||
|
|
||||||
[ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE}
|
# Start main loop in the background
|
||||||
while read -u 0 -r -e -p "user> " line; do
|
(
|
||||||
[ -z "${line}" ] && continue
|
${PSQL} -dmal -f <(echo "SELECT MAIN_LOOP();")
|
||||||
history -s -- "${line}" # add to history
|
) &
|
||||||
history -a ${RL_HISTORY_FILE} # save history to file
|
MAIN_PID=$!
|
||||||
|
|
||||||
# Run a command
|
# Stream from table to stdout
|
||||||
run REP "${line}"
|
(
|
||||||
|
while true; do
|
||||||
|
out=$(${PSQL} -dmal -f <(echo "SELECT read(1);"))
|
||||||
|
#echo "here stdout: [$out]" >> /tmp/debug.inout
|
||||||
|
#echo -en "${out}"
|
||||||
|
echo "${out}"
|
||||||
|
done
|
||||||
|
) &
|
||||||
|
STDOUT_PID=$!
|
||||||
|
|
||||||
|
# Perform readline input into stream table when requested
|
||||||
|
[ -r ${RL_HISTORY_FILE} ] && history -r ${RL_HISTORY_FILE}
|
||||||
|
while true; do
|
||||||
|
prompt=$(${PSQL} -dmal -f <(echo "SELECT wait_rl_prompt(0);"))
|
||||||
|
read -u 0 -r -e -p "${prompt}" line || break
|
||||||
|
#echo "here stdin: [$line]" >> /tmp/debug.inout
|
||||||
|
if [ "${line}" ]; then
|
||||||
|
history -s -- "${line}" # add to history
|
||||||
|
history -a ${RL_HISTORY_FILE} # save history to file
|
||||||
|
fi
|
||||||
|
|
||||||
|
${PSQL} -dmal -v arg="${line}" \
|
||||||
|
-f <(echo "SELECT writeline(:'arg', 0);") >/dev/null
|
||||||
done
|
done
|
||||||
|
|
||||||
|
cleanup
|
||||||
|
Loading…
Reference in New Issue
Block a user