-\i init.sql
-\i io.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 is_pair(ast integer) RETURNS boolean AS $$
-BEGIN
- RETURN _sequential_Q(ast) AND _count(ast) > 0;
-END; $$ LANGUAGE plpgsql;
-
-CREATE OR REPLACE FUNCTION quasiquote(ast integer) RETURNS integer AS $$
-DECLARE
- a0 integer;
- a00 integer;
-BEGIN
- IF NOT is_pair(ast) THEN
- RETURN _list(ARRAY[_symbolv('quote'), ast]);
- ELSE
- a0 := _nth(ast, 0);
- IF _symbol_Q(a0) AND a0 = _symbolv('unquote') THEN
- RETURN _nth(ast, 1);
- ELSE
- a00 := _nth(a0, 0);
- IF _symbol_Q(a00) AND a00 = _symbolv('splice-unquote') THEN
- RETURN _list(ARRAY[_symbolv('concat'),
- _nth(a0, 1),
- quasiquote(_rest(ast))]);
- END IF;
- END IF;
- RETURN _list(ARRAY[_symbolv('cons'),
- quasiquote(_first(ast)),
- quasiquote(_rest(ast))]);
- END IF;
-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 val_string FROM value WHERE 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 = 'quote' THEN
- BEGIN
- RETURN _nth(ast, 1);
- END;
- WHEN a0sym = 'quasiquote' THEN
- BEGIN
- ast := quasiquote(_nth(ast, 1));
- 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 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
- 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;
-
+-- ---------------------------------------------------------
+-- step7_quote.sql
+
+\i init.sql
+\i io.sql
+\i types.sql
+\i reader.sql
+\i printer.sql
+\i envs.sql
+\i core.sql
+
+-- ---------------------------------------------------------
+
+CREATE SCHEMA mal;
+
+-- read
+CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$
+BEGIN
+ RETURN reader.read_str(line);
+END; $$ LANGUAGE plpgsql;
+
+-- eval
+CREATE FUNCTION mal.is_pair(ast integer) RETURNS boolean AS $$
+BEGIN
+ RETURN types._sequential_Q(ast) AND types._count(ast) > 0;
+END; $$ LANGUAGE plpgsql;
+
+CREATE FUNCTION mal.quasiquote(ast integer) RETURNS integer AS $$
+DECLARE
+ a0 integer;
+ a00 integer;
+BEGIN
+ IF NOT mal.is_pair(ast) THEN
+ RETURN types._list(ARRAY[types._symbolv('quote'), ast]);
+ ELSE
+ a0 := types._nth(ast, 0);
+ IF types._symbol_Q(a0) AND a0 = types._symbolv('unquote') THEN
+ RETURN types._nth(ast, 1);
+ ELSE
+ a00 := types._nth(a0, 0);
+ IF types._symbol_Q(a00) AND
+ a00 = types._symbolv('splice-unquote') THEN
+ RETURN types._list(ARRAY[types._symbolv('concat'),
+ types._nth(a0, 1),
+ mal.quasiquote(types._rest(ast))]);
+ END IF;
+ END IF;
+ RETURN types._list(ARRAY[types._symbolv('cons'),
+ mal.quasiquote(types._first(ast)),
+ mal.quasiquote(types._rest(ast))]);
+ END IF;
+END; $$ LANGUAGE plpgsql;
+
+CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$
+DECLARE
+ type integer;
+ seq integer[];
+ eseq integer[];
+ hash hstore;
+ ehash hstore;
+ kv RECORD;
+ e integer;
+ result integer;
+BEGIN
+ SELECT type_id INTO type FROM types.value WHERE value_id = ast;
+ CASE
+ WHEN type = 7 THEN
+ BEGIN
+ result := envs.get(env, ast);
+ END;
+ WHEN type IN (8, 9) THEN
+ BEGIN
+ SELECT val_seq INTO seq FROM types.value WHERE value_id = ast;
+ -- Evaluate each entry creating a new sequence
+ FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP
+ eseq[i] := mal.EVAL(seq[i], env);
+ END LOOP;
+ INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq)
+ RETURNING value_id INTO result;
+ END;
+ WHEN type = 10 THEN
+ BEGIN
+ SELECT val_hash INTO hash FROM types.value WHERE value_id = ast;
+ -- Evaluate each value for every key/value
+ FOR kv IN SELECT * FROM each(hash) LOOP
+ e := mal.EVAL(CAST(kv.value AS integer), env);
+ IF ehash IS NULL THEN
+ ehash := hstore(kv.key, CAST(e AS varchar));
+ ELSE
+ ehash := ehash || hstore(kv.key, CAST(e AS varchar));
+ END IF;
+ END LOOP;
+ INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash)
+ RETURNING value_id INTO result;
+ END;
+ ELSE
+ result := ast;
+ END CASE;
+
+ RETURN result;
+END; $$ LANGUAGE plpgsql;
+
+CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$
+DECLARE
+ type integer;
+ a0 integer;
+ a0sym varchar;
+ a1 integer;
+ let_env integer;
+ idx integer;
+ binds integer[];
+ el integer;
+ fn integer;
+ fname varchar;
+ args integer[];
+ cond integer;
+ fast integer;
+ fparams integer;
+ fenv integer;
+ result integer;
+BEGIN
+ LOOP
+ -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast));
+ SELECT type_id INTO type FROM types.value WHERE value_id = ast;
+ IF type <> 8 THEN
+ RETURN mal.eval_ast(ast, env);
+ END IF;
+ IF types._count(ast) = 0 THEN
+ RETURN ast;
+ END IF;
+
+ a0 := types._first(ast);
+ IF types._symbol_Q(a0) THEN
+ a0sym := (SELECT val_string FROM types.value WHERE value_id = a0);
+ ELSE
+ a0sym := '__<*fn*>__';
+ END IF;
+
+ CASE
+ WHEN a0sym = 'def!' THEN
+ BEGIN
+ RETURN envs.set(env, types._nth(ast, 1),
+ mal.EVAL(types._nth(ast, 2), env));
+ END;
+ WHEN a0sym = 'let*' THEN
+ BEGIN
+ let_env := envs.new(env);
+ a1 := types._nth(ast, 1);
+ binds := (SELECT val_seq FROM types.value WHERE value_id = a1);
+ idx := 1;
+ WHILE idx < array_length(binds, 1) LOOP
+ PERFORM envs.set(let_env, binds[idx],
+ mal.EVAL(binds[idx+1], let_env));
+ idx := idx + 2;
+ END LOOP;
+ env := let_env;
+ ast := types._nth(ast, 2);
+ CONTINUE; -- TCO
+ END;
+ WHEN a0sym = 'quote' THEN
+ BEGIN
+ RETURN types._nth(ast, 1);
+ END;
+ WHEN a0sym = 'quasiquote' THEN
+ BEGIN
+ ast := mal.quasiquote(types._nth(ast, 1));
+ CONTINUE; -- TCO
+ END;
+ WHEN a0sym = 'do' THEN
+ BEGIN
+ PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env);
+ ast := types._nth(ast, types._count(ast)-1);
+ CONTINUE; -- TCO
+ END;
+ WHEN a0sym = 'if' THEN
+ BEGIN
+ cond := mal.EVAL(types._nth(ast, 1), env);
+ SELECT type_id INTO type FROM types.value WHERE value_id = cond;
+ IF type = 0 OR type = 1 THEN -- nil or false
+ IF types._count(ast) > 3 THEN
+ ast := types._nth(ast, 3);
+ CONTINUE; -- TCO
+ ELSE
+ RETURN 0; -- nil
+ END IF;
+ ELSE
+ ast := types._nth(ast, 2);
+ CONTINUE; -- TCO
+ END IF;
+ END;
+ WHEN a0sym = 'fn*' THEN
+ BEGIN
+ RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env);
+ END;
+ ELSE
+ BEGIN
+ el := mal.eval_ast(ast, env);
+ SELECT type_id, val_string, ast_id, params_id, env_id
+ INTO type, fname, fast, fparams, fenv
+ FROM types.value WHERE value_id = types._first(el);
+ args := types._restArray(el);
+ IF type = 11 THEN
+ EXECUTE format('SELECT %s($1);', fname)
+ INTO result USING args;
+ RETURN result;
+ ELSIF type = 12 THEN
+ env := envs.new(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 FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$
+BEGIN
+ RETURN printer.pr_str(exp);
+END; $$ LANGUAGE plpgsql;
+
+
+-- repl
+
+-- repl_env is environment 0
+
+CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$
+BEGIN
+ RETURN mal.PRINT(mal.EVAL(mal.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 FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$
+BEGIN
+ RETURN mal.EVAL(args[1], 0);
+END; $$ LANGUAGE plpgsql;
+INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval');
+
+SELECT envs.vset(0, 'eval',
+ (SELECT value_id FROM types.value
+ WHERE val_string = 'mal.mal_eval')) \g '/dev/null'
+-- *ARGV* values are set by RUN
+SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null'
+
+
+-- core.mal: defined using the language itself
+SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
+SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null'
+
+CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL)
+ RETURNS integer AS $$
+DECLARE
+ line varchar;
+ output varchar;
+ allargs integer;
+BEGIN
+ PERFORM envs.vset(0, '*PWD*', types._stringv(pwd));
+
+ IF argstring IS NOT NULL THEN
+ allargs := mal.READ(argstring);
+ PERFORM envs.vset(0, '*ARGV*', types._rest(allargs));
+ PERFORM mal.REP('(load-file ' ||
+ printer.pr_str(types._first(allargs)) || ')');
+ PERFORM io.close(1);
+ PERFORM io.wait_flushed(1);
+ RETURN 0;
+ END IF;
+
+ WHILE true
+ LOOP
+ BEGIN
+ line := io.readline('user> ', 0);
+ IF line IS NULL THEN
+ PERFORM io.close(1);
+ RETURN 0;
+ END IF;
+ IF line NOT IN ('', E'\n') THEN
+ output := mal.REP(line);
+ PERFORM io.writeline(output);
+ END IF;
+
+ EXCEPTION WHEN OTHERS THEN
+ PERFORM io.writeline('Error: ' || SQLERRM);
+ END;
+ END LOOP;
+END; $$ LANGUAGE plpgsql;
HCoop / jackhill / mal.git / blobdiff