| 1 | -- --------------------------------------------------------- |
| 2 | -- step5_tco.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.eval_ast(ast integer, env integer) RETURNS integer AS $$ |
| 24 | DECLARE |
| 25 | type integer; |
| 26 | seq integer[]; |
| 27 | eseq integer[]; |
| 28 | hash hstore; |
| 29 | ehash hstore; |
| 30 | kv RECORD; |
| 31 | e integer; |
| 32 | result integer; |
| 33 | BEGIN |
| 34 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; |
| 35 | CASE |
| 36 | WHEN type = 7 THEN |
| 37 | BEGIN |
| 38 | result := envs.get(env, ast); |
| 39 | END; |
| 40 | WHEN type IN (8, 9) THEN |
| 41 | BEGIN |
| 42 | SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; |
| 43 | -- Evaluate each entry creating a new sequence |
| 44 | FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP |
| 45 | eseq[i] := mal.EVAL(seq[i], env); |
| 46 | END LOOP; |
| 47 | INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq) |
| 48 | RETURNING value_id INTO result; |
| 49 | END; |
| 50 | WHEN type = 10 THEN |
| 51 | BEGIN |
| 52 | SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; |
| 53 | -- Evaluate each value for every key/value |
| 54 | FOR kv IN SELECT * FROM each(hash) LOOP |
| 55 | e := mal.EVAL(CAST(kv.value AS integer), env); |
| 56 | IF ehash IS NULL THEN |
| 57 | ehash := hstore(kv.key, CAST(e AS varchar)); |
| 58 | ELSE |
| 59 | ehash := ehash || hstore(kv.key, CAST(e AS varchar)); |
| 60 | END IF; |
| 61 | END LOOP; |
| 62 | INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash) |
| 63 | RETURNING value_id INTO result; |
| 64 | END; |
| 65 | ELSE |
| 66 | result := ast; |
| 67 | END CASE; |
| 68 | |
| 69 | RETURN result; |
| 70 | END; $$ LANGUAGE plpgsql; |
| 71 | |
| 72 | CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ |
| 73 | DECLARE |
| 74 | type integer; |
| 75 | a0 integer; |
| 76 | a0sym varchar; |
| 77 | a1 integer; |
| 78 | let_env integer; |
| 79 | idx integer; |
| 80 | binds integer[]; |
| 81 | el integer; |
| 82 | fn integer; |
| 83 | fname varchar; |
| 84 | args integer[]; |
| 85 | cond integer; |
| 86 | fast integer; |
| 87 | fparams integer; |
| 88 | fenv integer; |
| 89 | result integer; |
| 90 | BEGIN |
| 91 | LOOP |
| 92 | -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); |
| 93 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; |
| 94 | IF type <> 8 THEN |
| 95 | RETURN mal.eval_ast(ast, env); |
| 96 | END IF; |
| 97 | IF types._count(ast) = 0 THEN |
| 98 | RETURN ast; |
| 99 | END IF; |
| 100 | |
| 101 | a0 := types._first(ast); |
| 102 | IF types._symbol_Q(a0) THEN |
| 103 | a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); |
| 104 | ELSE |
| 105 | a0sym := '__<*fn*>__'; |
| 106 | END IF; |
| 107 | |
| 108 | CASE |
| 109 | WHEN a0sym = 'def!' THEN |
| 110 | BEGIN |
| 111 | RETURN envs.set(env, types._nth(ast, 1), |
| 112 | mal.EVAL(types._nth(ast, 2), env)); |
| 113 | END; |
| 114 | WHEN a0sym = 'let*' THEN |
| 115 | BEGIN |
| 116 | let_env := envs.new(env); |
| 117 | a1 := types._nth(ast, 1); |
| 118 | binds := (SELECT val_seq FROM types.value WHERE value_id = a1); |
| 119 | idx := 1; |
| 120 | WHILE idx < array_length(binds, 1) LOOP |
| 121 | PERFORM envs.set(let_env, binds[idx], |
| 122 | mal.EVAL(binds[idx+1], let_env)); |
| 123 | idx := idx + 2; |
| 124 | END LOOP; |
| 125 | env := let_env; |
| 126 | ast := types._nth(ast, 2); |
| 127 | CONTINUE; -- TCO |
| 128 | END; |
| 129 | WHEN a0sym = 'do' THEN |
| 130 | BEGIN |
| 131 | PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); |
| 132 | ast := types._nth(ast, types._count(ast)-1); |
| 133 | CONTINUE; -- TCO |
| 134 | END; |
| 135 | WHEN a0sym = 'if' THEN |
| 136 | BEGIN |
| 137 | cond := mal.EVAL(types._nth(ast, 1), env); |
| 138 | SELECT type_id INTO type FROM types.value WHERE value_id = cond; |
| 139 | IF type = 0 OR type = 1 THEN -- nil or false |
| 140 | IF types._count(ast) > 3 THEN |
| 141 | ast := types._nth(ast, 3); |
| 142 | CONTINUE; -- TCO |
| 143 | ELSE |
| 144 | RETURN 0; -- nil |
| 145 | END IF; |
| 146 | ELSE |
| 147 | ast := types._nth(ast, 2); |
| 148 | CONTINUE; -- TCO |
| 149 | END IF; |
| 150 | END; |
| 151 | WHEN a0sym = 'fn*' THEN |
| 152 | BEGIN |
| 153 | RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); |
| 154 | END; |
| 155 | ELSE |
| 156 | BEGIN |
| 157 | el := mal.eval_ast(ast, env); |
| 158 | SELECT type_id, val_string, ast_id, params_id, env_id |
| 159 | INTO type, fname, fast, fparams, fenv |
| 160 | FROM types.value WHERE value_id = types._first(el); |
| 161 | args := types._restArray(el); |
| 162 | IF type = 11 THEN |
| 163 | EXECUTE format('SELECT %s($1);', fname) |
| 164 | INTO result USING args; |
| 165 | RETURN result; |
| 166 | ELSIF type = 12 THEN |
| 167 | env := envs.new(fenv, fparams, args); |
| 168 | ast := fast; |
| 169 | CONTINUE; -- TCO |
| 170 | ELSE |
| 171 | RAISE EXCEPTION 'Invalid function call'; |
| 172 | END IF; |
| 173 | END; |
| 174 | END CASE; |
| 175 | END LOOP; |
| 176 | END; $$ LANGUAGE plpgsql; |
| 177 | |
| 178 | -- print |
| 179 | CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ |
| 180 | BEGIN |
| 181 | RETURN printer.pr_str(exp); |
| 182 | END; $$ LANGUAGE plpgsql; |
| 183 | |
| 184 | |
| 185 | -- repl |
| 186 | |
| 187 | -- repl_env is environment 0 |
| 188 | |
| 189 | CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ |
| 190 | BEGIN |
| 191 | RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); |
| 192 | END; $$ LANGUAGE plpgsql; |
| 193 | |
| 194 | -- core.sql: defined using SQL (in core.sql) |
| 195 | -- repl_env is created and populated with core functions in by core.sql |
| 196 | |
| 197 | -- core.mal: defined using the language itself |
| 198 | SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' |
| 199 | |
| 200 | CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ |
| 201 | DECLARE |
| 202 | line varchar; |
| 203 | output varchar; |
| 204 | BEGIN |
| 205 | WHILE true |
| 206 | LOOP |
| 207 | BEGIN |
| 208 | line := io.readline('user> ', 0); |
| 209 | IF line IS NULL THEN |
| 210 | PERFORM io.close(1); |
| 211 | RETURN 0; |
| 212 | END IF; |
| 213 | IF line NOT IN ('', E'\n') THEN |
| 214 | output := mal.REP(line); |
| 215 | PERFORM io.writeline(output); |
| 216 | END IF; |
| 217 | |
| 218 | EXCEPTION WHEN OTHERS THEN |
| 219 | PERFORM io.writeline('Error: ' || SQLERRM); |
| 220 | END; |
| 221 | END LOOP; |
| 222 | END; $$ LANGUAGE plpgsql; |