plpgsql/step7_quote.sql

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