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