plpgsql/stepA_mal.sql

   1 -- ---------------------------------------------------------
   2 -- stepA_mal.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.is_macro_call(ast integer, env integer) RETURNS boolean AS $$
  55 DECLARE
  56     a0      integer;
  57     f       integer;
  58     result  boolean = false;
  59 BEGIN
  60     IF types._list_Q(ast) THEN
  61         a0 = types._first(ast);
  62         IF types._symbol_Q(a0) AND
  63            envs.find(env, types._valueToString(a0)) IS NOT NULL THEN
  64             f := envs.get(env, a0);
  65             SELECT macro INTO result FROM types.value WHERE value_id = f;
  66         END IF;
  67     END IF;
  68     RETURN result;
  69 END; $$ LANGUAGE plpgsql;
  70
  71 CREATE FUNCTION mal.macroexpand(ast integer, env integer) RETURNS integer AS $$
  72 DECLARE
  73     mac  integer;
  74 BEGIN
  75     WHILE mal.is_macro_call(ast, env)
  76     LOOP
  77         mac := envs.get(env, types._first(ast));
  78         ast := types._apply(mac, types._valueToArray(types._rest(ast)));
  79     END LOOP;
  80     RETURN ast;
  81 END; $$ LANGUAGE plpgsql;
  82
  83 CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$
  84 DECLARE
  85     type           integer;
  86     seq            integer[];
  87     eseq           integer[];
  88     hash           hstore;
  89     ehash          hstore;
  90     kv             RECORD;
  91     e              integer;
  92     result         integer;
  93 BEGIN
  94     SELECT type_id INTO type FROM types.value WHERE value_id = ast;
  95     CASE
  96     WHEN type = 7 THEN
  97     BEGIN
  98         result := envs.get(env, ast);
  99     END;
 100     WHEN type IN (8, 9) THEN
 101     BEGIN
 102         SELECT val_seq INTO seq FROM types.value WHERE value_id = ast;
 103         -- Evaluate each entry creating a new sequence
 104         FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP
 105             eseq[i] := mal.EVAL(seq[i], env);
 106         END LOOP;
 107         INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq)
 108             RETURNING value_id INTO result;
 109     END;
 110     WHEN type = 10 THEN
 111     BEGIN
 112         SELECT val_hash INTO hash FROM types.value WHERE value_id = ast;
 113         -- Evaluate each value for every key/value
 114         FOR kv IN SELECT * FROM each(hash) LOOP
 115             e := mal.EVAL(CAST(kv.value AS integer), env);
 116             IF ehash IS NULL THEN
 117                 ehash := hstore(kv.key, CAST(e AS varchar));
 118             ELSE
 119                 ehash := ehash || hstore(kv.key, CAST(e AS varchar));
 120             END IF;
 121         END LOOP;
 122         INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash)
 123             RETURNING value_id INTO result;
 124     END;
 125     ELSE
 126         result := ast;
 127     END CASE;
 128
 129     RETURN result;
 130 END; $$ LANGUAGE plpgsql;
 131
 132 CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$
 133 DECLARE
 134     type     integer;
 135     a0       integer;
 136     a0sym    varchar;
 137     a1       integer;
 138     a2       integer;
 139     let_env  integer;
 140     idx      integer;
 141     binds    integer[];
 142     exprs    integer[];
 143     el       integer;
 144     fn       integer;
 145     fname    varchar;
 146     args     integer[];
 147     cond     integer;
 148     fast     integer;
 149     fparams  integer;
 150     fenv     integer;
 151     result   integer;
 152 BEGIN
 153   LOOP
 154     -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast));
 155     SELECT type_id INTO type FROM types.value WHERE value_id = ast;
 156     IF type <> 8 THEN
 157         RETURN mal.eval_ast(ast, env);
 158     END IF;
 159
 160     ast := mal.macroexpand(ast, env);
 161     SELECT type_id INTO type FROM types.value WHERE value_id = ast;
 162     IF type <> 8 THEN
 163         RETURN mal.eval_ast(ast, env);
 164     END IF;
 165     IF types._count(ast) = 0 THEN
 166         RETURN ast;
 167     END IF;
 168
 169     a0 := types._first(ast);
 170     IF types._symbol_Q(a0) THEN
 171         a0sym := (SELECT val_string FROM types.value WHERE value_id = a0);
 172     ELSE
 173         a0sym := '__<*fn*>__';
 174     END IF;
 175
 176     CASE
 177     WHEN a0sym = 'def!' THEN
 178     BEGIN
 179         RETURN envs.set(env, types._nth(ast, 1),
 180                         mal.EVAL(types._nth(ast, 2), env));
 181     END;
 182     WHEN a0sym = 'let*' THEN
 183     BEGIN
 184         let_env := envs.new(env);
 185         a1 := types._nth(ast, 1);
 186         binds := (SELECT val_seq FROM types.value WHERE value_id = a1);
 187         idx := 1;
 188         WHILE idx < array_length(binds, 1) LOOP
 189             PERFORM envs.set(let_env, binds[idx],
 190                                       mal.EVAL(binds[idx+1], let_env));
 191             idx := idx + 2;
 192         END LOOP;
 193         env := let_env;
 194         ast := types._nth(ast, 2);
 195         CONTINUE; -- TCO
 196     END;
 197     WHEN a0sym = 'quote' THEN
 198     BEGIN
 199         RETURN types._nth(ast, 1);
 200     END;
 201     WHEN a0sym = 'quasiquote' THEN
 202     BEGIN
 203         ast := mal.quasiquote(types._nth(ast, 1));
 204         CONTINUE; -- TCO
 205     END;
 206     WHEN a0sym = 'defmacro!' THEN
 207     BEGIN
 208         fn := mal.EVAL(types._nth(ast, 2), env);
 209         fn := types._macro(fn);
 210         RETURN envs.set(env, types._nth(ast, 1), fn);
 211     END;
 212     WHEN a0sym = 'macroexpand' THEN
 213     BEGIN
 214         RETURN mal.macroexpand(types._nth(ast, 1), env);
 215     END;
 216     WHEN a0sym = 'try*' THEN
 217     BEGIN
 218         BEGIN
 219             RETURN mal.EVAL(types._nth(ast, 1), env);
 220             EXCEPTION WHEN OTHERS THEN
 221                 IF types._count(ast) >= 3 THEN
 222                     a2 = types._nth(ast, 2);
 223                     IF types._valueToString(types._nth(a2, 0)) = 'catch*' THEN
 224                         binds := ARRAY[types._nth(a2, 1)];
 225                         exprs := ARRAY[types._stringv(SQLERRM)];
 226                         env := envs.new(env, types._list(binds), exprs);
 227                         RETURN mal.EVAL(types._nth(a2, 2), env);
 228                     END IF;
 229                 END IF;
 230                 RAISE;
 231         END;
 232     END;
 233     WHEN a0sym = 'do' THEN
 234     BEGIN
 235         PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env);
 236         ast := types._nth(ast, types._count(ast)-1);
 237         CONTINUE; -- TCO
 238     END;
 239     WHEN a0sym = 'if' THEN
 240     BEGIN
 241         cond := mal.EVAL(types._nth(ast, 1), env);
 242         SELECT type_id INTO type FROM types.value WHERE value_id = cond;
 243         IF type = 0 OR type = 1 THEN -- nil or false
 244             IF types._count(ast) > 3 THEN
 245                 ast := types._nth(ast, 3);
 246                 CONTINUE; -- TCO
 247             ELSE
 248                 RETURN 0; -- nil
 249             END IF;
 250         ELSE
 251             ast := types._nth(ast, 2);
 252             CONTINUE; -- TCO
 253         END IF;
 254     END;
 255     WHEN a0sym = 'fn*' THEN
 256     BEGIN
 257         RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env);
 258     END;
 259     ELSE
 260     BEGIN
 261         el := mal.eval_ast(ast, env);
 262         SELECT type_id, val_string, ast_id, params_id, env_id
 263             INTO type, fname, fast, fparams, fenv
 264             FROM types.value WHERE value_id = types._first(el);
 265         args := types._restArray(el);
 266         IF type = 11 THEN
 267             EXECUTE format('SELECT %s($1);', fname)
 268                 INTO result USING args;
 269             RETURN result;
 270         ELSIF type = 12 THEN
 271             env := envs.new(fenv, fparams, args);
 272             ast := fast;
 273             CONTINUE; -- TCO
 274         ELSE
 275             RAISE EXCEPTION 'Invalid function call';
 276         END IF;
 277     END;
 278     END CASE;
 279   END LOOP;
 280 END; $$ LANGUAGE plpgsql;
 281
 282 -- print
 283 CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$
 284 BEGIN
 285     RETURN printer.pr_str(exp);
 286 END; $$ LANGUAGE plpgsql;
 287
 288
 289 -- repl
 290
 291 -- repl_env is environment 0
 292
 293 CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$
 294 BEGIN
 295     RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0));
 296 END; $$ LANGUAGE plpgsql;
 297
 298 -- core.sql: defined using SQL (in core.sql)
 299 -- repl_env is created and populated with core functions in by core.sql
 300 CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$
 301 BEGIN
 302     RETURN mal.EVAL(args[1], 0);
 303 END; $$ LANGUAGE plpgsql;
 304 INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval');
 305
 306 SELECT envs.vset(0, 'eval',
 307                    (SELECT value_id FROM types.value
 308                     WHERE val_string = 'mal.mal_eval')) \g '/dev/null'
 309 -- *ARGV* values are set by RUN
 310 SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null'
 311
 312
 313 -- core.mal: defined using the language itself
 314 SELECT mal.REP('(def! *host-language* "plpqsql")') \g '/dev/null'
 315 SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null'
 316 SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))') \g '/dev/null'
 317 SELECT mal.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'
 318 SELECT mal.REP('(def! inc (fn* [x] (+ x 1)))') \g '/dev/null'
 319 SELECT mal.REP('(def! gensym (let* [counter (atom 0)] (fn* [] (symbol (str "G__" (swap! counter inc))))))') \g '/dev/null'
 320 SELECT mal.REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))') \g '/dev/null'
 321
 322 CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL)
 323     RETURNS integer AS $$
 324 DECLARE
 325     line      varchar;
 326     output    varchar;
 327     allargs   integer;
 328 BEGIN
 329     PERFORM envs.vset(0, '*PWD*', types._stringv(pwd));
 330
 331     IF argstring IS NOT NULL THEN
 332         allargs := mal.READ(argstring);
 333         PERFORM envs.vset(0, '*ARGV*', types._rest(allargs));
 334         PERFORM mal.REP('(load-file ' ||
 335                         printer.pr_str(types._first(allargs)) || ')');
 336         PERFORM io.close(1);
 337         PERFORM io.wait_flushed(1);
 338         RETURN 0;
 339     END IF;
 340
 341     PERFORM mal.REP('(println (str "Mal [" *host-language* "]"))');
 342     WHILE true
 343     LOOP
 344         BEGIN
 345             line := io.readline('user> ', 0);
 346             IF line IS NULL THEN
 347                 PERFORM io.close(1);
 348                 RETURN 0;
 349             END IF;
 350             IF line NOT IN ('', E'\n') THEN
 351                 output := mal.REP(line);
 352                 PERFORM io.writeline(output);
 353             END IF;
 354
 355             EXCEPTION WHEN OTHERS THEN
 356                 PERFORM io.writeline('Error: ' || SQLERRM);
 357         END;
 358     END LOOP;
 359 END; $$ LANGUAGE plpgsql;