Commit | Line | Data |
---|---|---|
494792ab JM |
1 | -- --------------------------------------------------------- |
2 | -- step6_file.sql | |
3 | ||
5340418b | 4 | \i init.sql |
53105a77 | 5 | \i io.sql |
5340418b JM |
6 | \i types.sql |
7 | \i reader.sql | |
8 | \i printer.sql | |
494792ab | 9 | \i envs.sql |
5340418b JM |
10 | \i core.sql |
11 | ||
12 | -- --------------------------------------------------------- | |
494792ab JM |
13 | |
14 | CREATE SCHEMA mal; | |
5340418b JM |
15 | |
16 | -- read | |
494792ab | 17 | CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ |
5340418b | 18 | BEGIN |
494792ab | 19 | RETURN reader.read_str(line); |
5340418b JM |
20 | END; $$ LANGUAGE plpgsql; |
21 | ||
22 | -- eval | |
494792ab | 23 | CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ |
5340418b JM |
24 | DECLARE |
25 | type integer; | |
b642c0db JM |
26 | seq integer[]; |
27 | eseq integer[]; | |
28 | hash hstore; | |
29 | ehash hstore; | |
30 | kv RECORD; | |
5340418b JM |
31 | e integer; |
32 | result integer; | |
33 | BEGIN | |
494792ab | 34 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; |
5340418b JM |
35 | CASE |
36 | WHEN type = 7 THEN | |
37 | BEGIN | |
494792ab | 38 | result := envs.get(env, ast); |
5340418b | 39 | END; |
b642c0db | 40 | WHEN type IN (8, 9) THEN |
5340418b | 41 | BEGIN |
494792ab | 42 | SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; |
b642c0db JM |
43 | -- Evaluate each entry creating a new sequence |
44 | FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP | |
494792ab | 45 | eseq[i] := mal.EVAL(seq[i], env); |
b642c0db | 46 | END LOOP; |
494792ab | 47 | INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq) |
97c0256d | 48 | RETURNING value_id INTO result; |
b642c0db JM |
49 | END; |
50 | WHEN type = 10 THEN | |
51 | BEGIN | |
494792ab | 52 | SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; |
b642c0db JM |
53 | -- Evaluate each value for every key/value |
54 | FOR kv IN SELECT * FROM each(hash) LOOP | |
494792ab | 55 | e := mal.EVAL(CAST(kv.value AS integer), env); |
b642c0db JM |
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; | |
5340418b | 61 | END LOOP; |
494792ab | 62 | INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash) |
b642c0db | 63 | RETURNING value_id INTO result; |
5340418b JM |
64 | END; |
65 | ELSE | |
66 | result := ast; | |
67 | END CASE; | |
68 | ||
69 | RETURN result; | |
70 | END; $$ LANGUAGE plpgsql; | |
71 | ||
494792ab | 72 | CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ |
5340418b JM |
73 | DECLARE |
74 | type integer; | |
75 | a0 integer; | |
76 | a0sym varchar; | |
77 | a1 integer; | |
78 | let_env integer; | |
b642c0db | 79 | idx integer; |
5340418b | 80 | binds integer[]; |
5340418b JM |
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 | |
494792ab JM |
92 | -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); |
93 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; | |
5340418b | 94 | IF type <> 8 THEN |
494792ab JM |
95 | RETURN mal.eval_ast(ast, env); |
96 | END IF; | |
97 | IF types._count(ast) = 0 THEN | |
98 | RETURN ast; | |
5340418b JM |
99 | END IF; |
100 | ||
494792ab JM |
101 | a0 := types._first(ast); |
102 | IF types._symbol_Q(a0) THEN | |
103 | a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); | |
5340418b JM |
104 | ELSE |
105 | a0sym := '__<*fn*>__'; | |
106 | END IF; | |
107 | ||
5340418b JM |
108 | CASE |
109 | WHEN a0sym = 'def!' THEN | |
110 | BEGIN | |
494792ab JM |
111 | RETURN envs.set(env, types._nth(ast, 1), |
112 | mal.EVAL(types._nth(ast, 2), env)); | |
5340418b JM |
113 | END; |
114 | WHEN a0sym = 'let*' THEN | |
115 | BEGIN | |
494792ab JM |
116 | let_env := envs.new(env); |
117 | a1 := types._nth(ast, 1); | |
118 | binds := (SELECT val_seq FROM types.value WHERE value_id = a1); | |
b642c0db JM |
119 | idx := 1; |
120 | WHILE idx < array_length(binds, 1) LOOP | |
494792ab JM |
121 | PERFORM envs.set(let_env, binds[idx], |
122 | mal.EVAL(binds[idx+1], let_env)); | |
b642c0db | 123 | idx := idx + 2; |
5340418b JM |
124 | END LOOP; |
125 | env := let_env; | |
494792ab | 126 | ast := types._nth(ast, 2); |
5340418b JM |
127 | CONTINUE; -- TCO |
128 | END; | |
129 | WHEN a0sym = 'do' THEN | |
130 | BEGIN | |
494792ab JM |
131 | PERFORM mal.eval_ast(types._slice(ast, 1, types._count(ast)-1), env); |
132 | ast := types._nth(ast, types._count(ast)-1); | |
5340418b JM |
133 | CONTINUE; -- TCO |
134 | END; | |
135 | WHEN a0sym = 'if' THEN | |
136 | BEGIN | |
494792ab JM |
137 | cond := mal.EVAL(types._nth(ast, 1), env); |
138 | SELECT type_id INTO type FROM types.value WHERE value_id = cond; | |
5340418b | 139 | IF type = 0 OR type = 1 THEN -- nil or false |
494792ab JM |
140 | IF types._count(ast) > 3 THEN |
141 | ast := types._nth(ast, 3); | |
5340418b JM |
142 | CONTINUE; -- TCO |
143 | ELSE | |
144 | RETURN 0; -- nil | |
145 | END IF; | |
146 | ELSE | |
494792ab | 147 | ast := types._nth(ast, 2); |
5340418b JM |
148 | CONTINUE; -- TCO |
149 | END IF; | |
150 | END; | |
151 | WHEN a0sym = 'fn*' THEN | |
152 | BEGIN | |
494792ab | 153 | RETURN types._malfunc(types._nth(ast, 2), types._nth(ast, 1), env); |
5340418b JM |
154 | END; |
155 | ELSE | |
156 | BEGIN | |
494792ab | 157 | el := mal.eval_ast(ast, env); |
4facce82 | 158 | SELECT type_id, val_string, ast_id, params_id, env_id |
b642c0db | 159 | INTO type, fname, fast, fparams, fenv |
494792ab JM |
160 | FROM types.value WHERE value_id = types._first(el); |
161 | args := types._restArray(el); | |
5340418b JM |
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 | |
494792ab | 167 | env := envs.new(fenv, fparams, args); |
5340418b JM |
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 | ||
494792ab | 179 | CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ |
5340418b | 180 | BEGIN |
494792ab | 181 | RETURN printer.pr_str(exp); |
5340418b JM |
182 | END; $$ LANGUAGE plpgsql; |
183 | ||
184 | ||
185 | -- repl | |
186 | ||
187 | -- repl_env is environment 0 | |
188 | ||
494792ab | 189 | CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ |
5340418b | 190 | BEGIN |
494792ab | 191 | RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); |
5340418b JM |
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 | |
494792ab | 196 | CREATE FUNCTION mal.mal_eval(args integer[]) RETURNS integer AS $$ |
5340418b | 197 | BEGIN |
494792ab | 198 | RETURN mal.EVAL(args[1], 0); |
5340418b | 199 | END; $$ LANGUAGE plpgsql; |
494792ab | 200 | INSERT INTO types.value (type_id, val_string) VALUES (11, 'mal.mal_eval'); |
5340418b | 201 | |
494792ab JM |
202 | SELECT envs.vset(0, 'eval', |
203 | (SELECT value_id FROM types.value | |
204 | WHERE val_string = 'mal.mal_eval')) \g '/dev/null' | |
5340418b | 205 | -- *ARGV* values are set by RUN |
494792ab | 206 | SELECT envs.vset(0, '*ARGV*', mal.READ('()')) \g '/dev/null' |
5340418b JM |
207 | |
208 | ||
209 | -- core.mal: defined using the language itself | |
494792ab | 210 | SELECT mal.REP('(def! not (fn* (a) (if a false true)))') \g '/dev/null' |
e6d41de4 | 211 | SELECT mal.REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') \g '/dev/null' |
5340418b | 212 | |
494792ab JM |
213 | CREATE FUNCTION mal.MAIN(pwd varchar, argstring varchar DEFAULT NULL) |
214 | RETURNS integer AS $$ | |
53105a77 | 215 | DECLARE |
494792ab JM |
216 | line varchar; |
217 | output varchar; | |
218 | allargs integer; | |
53105a77 | 219 | BEGIN |
494792ab JM |
220 | PERFORM envs.vset(0, '*PWD*', types._stringv(pwd)); |
221 | ||
222 | IF argstring IS NOT NULL THEN | |
223 | allargs := mal.READ(argstring); | |
224 | PERFORM envs.vset(0, '*ARGV*', types._rest(allargs)); | |
225 | PERFORM mal.REP('(load-file ' || | |
226 | printer.pr_str(types._first(allargs)) || ')'); | |
227 | PERFORM io.close(1); | |
228 | PERFORM io.wait_flushed(1); | |
229 | RETURN 0; | |
230 | END IF; | |
231 | ||
53105a77 JM |
232 | WHILE true |
233 | LOOP | |
234 | BEGIN | |
494792ab JM |
235 | line := io.readline('user> ', 0); |
236 | IF line IS NULL THEN | |
237 | PERFORM io.close(1); | |
238 | RETURN 0; | |
239 | END IF; | |
240 | IF line NOT IN ('', E'\n') THEN | |
241 | output := mal.REP(line); | |
242 | PERFORM io.writeline(output); | |
53105a77 JM |
243 | END IF; |
244 | ||
245 | EXCEPTION WHEN OTHERS THEN | |
494792ab | 246 | PERFORM io.writeline('Error: ' || SQLERRM); |
53105a77 JM |
247 | END; |
248 | END LOOP; | |
249 | END; $$ LANGUAGE plpgsql; |