plpgsql/step7_quote.sql

   1 \set VERBOSITY 'terse'
   2
   3 \i init.sql
   4 \i types.sql
   5 \i reader.sql
   6 \i printer.sql
   7 \i env.sql
   8 \i core.sql
   9
  10 -- ---------------------------------------------------------
  11 -- step1_read_print.sql
  12
  13 -- read
  14 CREATE OR REPLACE FUNCTION READ(line varchar) RETURNS integer AS $$
  15 BEGIN
  16     RETURN read_str(line);
  17 END; $$ LANGUAGE plpgsql;
  18
  19 -- eval
  20 CREATE OR REPLACE FUNCTION is_pair(ast integer) RETURNS boolean AS $$
  21 BEGIN
  22     RETURN _sequential_Q(ast) AND _count(ast) > 0;
  23 END; $$ LANGUAGE plpgsql;
  24
  25 CREATE OR REPLACE FUNCTION quasiquote(ast integer) RETURNS integer AS $$
  26 DECLARE
  27     a0   integer;
  28     a00  integer;
  29 BEGIN
  30     IF NOT is_pair(ast) THEN
  31         RETURN _list(ARRAY[_symbolv('quote'), ast]);
  32     ELSE
  33         a0 := _nth(ast, 0);
  34         IF _symbol_Q(a0) AND a0 = _symbolv('unquote') THEN
  35             RETURN _nth(ast, 1);
  36         ELSE
  37             a00 := _nth(a0, 0);
  38             IF _symbol_Q(a00) AND a00 = _symbolv('splice-unquote') THEN
  39                 RETURN _list(ARRAY[_symbolv('concat'),
  40                                    _nth(a0, 1),
  41                                    quasiquote(_rest(ast))]);
  42             END IF;
  43         END IF;
  44         RETURN _list(ARRAY[_symbolv('cons'),
  45                            quasiquote(_first(ast)),
  46                            quasiquote(_rest(ast))]);
  47     END IF;
  48 END; $$ LANGUAGE plpgsql;
  49
  50 CREATE OR REPLACE FUNCTION eval_ast(ast integer, env integer) RETURNS integer AS $$
  51 DECLARE
  52     type           integer;
  53     symkey         varchar;
  54     vid            integer;
  55     i              integer;
  56     src_coll_id    integer;
  57     dst_coll_id    integer = NULL;
  58     e              integer;
  59     result         integer;
  60 BEGIN
  61     SELECT type_id INTO type FROM value WHERE value_id = ast;
  62     CASE
  63     WHEN type = 7 THEN
  64     BEGIN
  65         result := env_get(env, ast);
  66     END;
  67     WHEN type = 8 OR type = 9 THEN
  68     BEGIN
  69         src_coll_id := (SELECT collection_id FROM value WHERE value_id = ast);
  70         FOR vid, i IN (SELECT value_id, idx FROM collection
  71                        WHERE collection_id = src_coll_id)
  72         LOOP
  73             e := EVAL(vid, env);
  74             IF dst_coll_id IS NULL THEN
  75                 dst_coll_id := COALESCE((SELECT Max(collection_id)
  76                                          FROM collection)+1,0);
  77             END IF;
  78             -- Evaluated each entry
  79             INSERT INTO collection (collection_id, idx, value_id)
  80                 VALUES (dst_coll_id, i, e);
  81         END LOOP;
  82         -- Create value entry pointing to new collection
  83         INSERT INTO value (type_id, collection_id)
  84             VALUES (type, dst_coll_id)
  85             RETURNING value_id INTO result;
  86     END;
  87     ELSE
  88         result := ast;
  89     END CASE;
  90
  91     RETURN result;
  92 END; $$ LANGUAGE plpgsql;
  93
  94 CREATE OR REPLACE FUNCTION EVAL(ast integer, env integer) RETURNS integer AS $$
  95 DECLARE
  96     type     integer;
  97     a0       integer;
  98     a0sym    varchar;
  99     a1       integer;
 100     let_env  integer;
 101     binds    integer[];
 102     exprs    integer[];
 103     el       integer;
 104     fn       integer;
 105     fname    varchar;
 106     args     integer[];
 107     cond     integer;
 108     fast     integer;
 109     fparams  integer;
 110     fenv     integer;
 111     result   integer;
 112 BEGIN
 113   LOOP
 114     --RAISE NOTICE 'EVAL: % [%]', pr_str(ast), ast;
 115     SELECT type_id INTO type FROM value WHERE value_id = ast;
 116     IF type <> 8 THEN
 117         RETURN eval_ast(ast, env);
 118     END IF;
 119
 120     a0 := _first(ast);
 121     IF _symbol_Q(a0) THEN
 122         a0sym := (SELECT string.value FROM string
 123                   INNER JOIN value ON value.val_string_id=string.string_id
 124                   WHERE value.value_id = a0);
 125     ELSE
 126         a0sym := '__<*fn*>__';
 127     END IF;
 128
 129     --RAISE NOTICE 'ast: %, a0sym: %', ast, a0sym;
 130     CASE
 131     WHEN a0sym = 'def!' THEN
 132     BEGIN
 133         RETURN env_set(env, _nth(ast, 1), EVAL(_nth(ast, 2), env));
 134     END;
 135     WHEN a0sym = 'let*' THEN
 136     BEGIN
 137         let_env := env_new(env);
 138         a1 := _nth(ast, 1);
 139         binds := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
 140                        ON collection.collection_id=value.collection_id
 141                        WHERE value.value_id = a1
 142                        AND (collection.idx % 2) = 0
 143                        ORDER BY collection.idx);
 144         exprs := ARRAY(SELECT collection.value_id FROM collection INNER JOIN value
 145                        ON collection.collection_id=value.collection_id
 146                        WHERE value.value_id = a1
 147                        AND (collection.idx % 2) = 1
 148                        ORDER BY collection.idx);
 149         FOR idx IN array_lower(binds, 1) .. array_upper(binds, 1)
 150         LOOP
 151             PERFORM env_set(let_env, binds[idx], EVAL(exprs[idx], let_env));
 152         END LOOP;
 153         env := let_env;
 154         ast := _nth(ast, 2);
 155         CONTINUE; -- TCO
 156     END;
 157     WHEN a0sym = 'quote' THEN
 158     BEGIN
 159         RETURN _nth(ast, 1);
 160     END;
 161     WHEN a0sym = 'quasiquote' THEN
 162     BEGIN
 163         ast := quasiquote(_nth(ast, 1));
 164         CONTINUE; -- TCO
 165     END;
 166     WHEN a0sym = 'do' THEN
 167     BEGIN
 168         PERFORM eval_ast(_slice(ast, 1, _count(ast)-1), env);
 169         ast := _nth(ast, _count(ast)-1);
 170         CONTINUE; -- TCO
 171     END;
 172     WHEN a0sym = 'if' THEN
 173     BEGIN
 174         cond := EVAL(_nth(ast, 1), env);
 175         SELECT type_id INTO type FROM value WHERE value_id = cond;
 176         IF type = 0 OR type = 1 THEN -- nil or false
 177             IF _count(ast) > 3 THEN
 178                 ast := _nth(ast, 3);
 179                 CONTINUE; -- TCO
 180             ELSE
 181                 RETURN 0; -- nil
 182             END IF;
 183         ELSE
 184             ast := _nth(ast, 2);
 185             CONTINUE; -- TCO
 186         END IF;
 187     END;
 188     WHEN a0sym = 'fn*' THEN
 189     BEGIN
 190         RETURN _function(_nth(ast, 2), _nth(ast, 1), env);
 191     END;
 192     ELSE
 193     BEGIN
 194         el := eval_ast(ast, env);
 195         SELECT type_id, collection_id, function_name
 196             INTO type, fn, fname
 197             FROM value WHERE value_id = _first(el);
 198         args := _restArray(el);
 199         IF type = 11 THEN
 200             EXECUTE format('SELECT %s($1);', fname)
 201                 INTO result USING args;
 202             RETURN result;
 203         ELSIF type = 12 THEN
 204             SELECT value_id, params_id, env_id
 205                 INTO fast, fparams, fenv
 206                 FROM collection
 207                 WHERE collection_id = fn;
 208             env := env_new_bindings(fenv, fparams, args);
 209             ast := fast;
 210             CONTINUE; -- TCO
 211         ELSE
 212             RAISE EXCEPTION 'Invalid function call';
 213         END IF;
 214     END;
 215     END CASE;
 216   END LOOP;
 217 END; $$ LANGUAGE plpgsql;
 218
 219 -- print
 220 CREATE OR REPLACE FUNCTION PRINT(exp integer) RETURNS varchar AS $$
 221 BEGIN
 222     RETURN pr_str(exp);
 223 END; $$ LANGUAGE plpgsql;
 224
 225
 226 -- repl
 227
 228 -- repl_env is environment 0
 229
 230 CREATE OR REPLACE FUNCTION REP(line varchar) RETURNS varchar AS $$
 231 BEGIN
 232     RETURN PRINT(EVAL(READ(line), 0));
 233 END; $$ LANGUAGE plpgsql;
 234
 235 -- core.sql: defined using SQL (in core.sql)
 236 -- repl_env is created and populated with core functions in by core.sql
 237 CREATE OR REPLACE FUNCTION mal_eval(args integer[]) RETURNS integer AS $$
 238 BEGIN
 239     RETURN EVAL(args[1], 0);
 240 END; $$ LANGUAGE plpgsql;
 241 INSERT INTO value (type_id, function_name) VALUES (11, 'mal_eval');
 242
 243 SELECT env_vset(0, 'eval',
 244                    (SELECT value_id FROM value
 245                     WHERE function_name = 'mal_eval')) \g '/dev/null'
 246 -- *ARGV* values are set by RUN
 247 SELECT env_vset(0, '*ARGV*', READ('()'));
 248
 249
 250 -- core.mal: defined using the language itself
 251 SELECT REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
 252 SELECT REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))') \g '/dev/null'
 253
 254 CREATE OR REPLACE FUNCTION RUN(argstring varchar) RETURNS void AS $$
 255 DECLARE
 256     allargs  integer;
 257 BEGIN
 258     allargs := READ(argstring);
 259     PERFORM env_vset(0, '*ARGV*', _rest(allargs));
 260     PERFORM REP('(load-file ' || pr_str(_first(allargs)) || ')');
 261     RETURN;
 262 END; $$ LANGUAGE plpgsql;
 263