Commit | Line | Data |
---|---|---|
494792ab JM |
1 | -- --------------------------------------------------------- |
2 | -- step3_env.sql | |
3 | ||
adc5b4fb | 4 | \i init.sql |
53105a77 | 5 | \i io.sql |
adc5b4fb JM |
6 | \i types.sql |
7 | \i reader.sql | |
8 | \i printer.sql | |
494792ab | 9 | \i envs.sql |
adc5b4fb JM |
10 | |
11 | -- --------------------------------------------------------- | |
494792ab JM |
12 | |
13 | CREATE SCHEMA mal; | |
adc5b4fb JM |
14 | |
15 | -- read | |
494792ab | 16 | CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$ |
adc5b4fb | 17 | BEGIN |
494792ab | 18 | RETURN reader.read_str(line); |
adc5b4fb JM |
19 | END; $$ LANGUAGE plpgsql; |
20 | ||
21 | -- eval | |
494792ab | 22 | CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$ |
adc5b4fb JM |
23 | DECLARE |
24 | type integer; | |
b642c0db JM |
25 | seq integer[]; |
26 | eseq integer[]; | |
27 | hash hstore; | |
28 | ehash hstore; | |
29 | kv RECORD; | |
adc5b4fb JM |
30 | e integer; |
31 | result integer; | |
32 | BEGIN | |
494792ab | 33 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; |
adc5b4fb JM |
34 | CASE |
35 | WHEN type = 7 THEN | |
36 | BEGIN | |
494792ab | 37 | result := envs.get(env, ast); |
adc5b4fb | 38 | END; |
b642c0db | 39 | WHEN type IN (8, 9) THEN |
adc5b4fb | 40 | BEGIN |
494792ab | 41 | SELECT val_seq INTO seq FROM types.value WHERE value_id = ast; |
b642c0db JM |
42 | -- Evaluate each entry creating a new sequence |
43 | FOR i IN 1 .. COALESCE(array_length(seq, 1), 0) LOOP | |
494792ab | 44 | eseq[i] := mal.EVAL(seq[i], env); |
b642c0db | 45 | END LOOP; |
494792ab | 46 | INSERT INTO types.value (type_id, val_seq) VALUES (type, eseq) |
97c0256d | 47 | RETURNING value_id INTO result; |
b642c0db JM |
48 | END; |
49 | WHEN type = 10 THEN | |
50 | BEGIN | |
494792ab | 51 | SELECT val_hash INTO hash FROM types.value WHERE value_id = ast; |
b642c0db JM |
52 | -- Evaluate each value for every key/value |
53 | FOR kv IN SELECT * FROM each(hash) LOOP | |
494792ab | 54 | e := mal.EVAL(CAST(kv.value AS integer), env); |
b642c0db JM |
55 | IF ehash IS NULL THEN |
56 | ehash := hstore(kv.key, CAST(e AS varchar)); | |
57 | ELSE | |
58 | ehash := ehash || hstore(kv.key, CAST(e AS varchar)); | |
59 | END IF; | |
adc5b4fb | 60 | END LOOP; |
494792ab | 61 | INSERT INTO types.value (type_id, val_hash) VALUES (type, ehash) |
b642c0db | 62 | RETURNING value_id INTO result; |
adc5b4fb JM |
63 | END; |
64 | ELSE | |
65 | result := ast; | |
66 | END CASE; | |
67 | ||
68 | RETURN result; | |
69 | END; $$ LANGUAGE plpgsql; | |
70 | ||
494792ab | 71 | CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$ |
adc5b4fb JM |
72 | DECLARE |
73 | type integer; | |
74 | a0 integer; | |
75 | a0sym varchar; | |
76 | a1 integer; | |
77 | let_env integer; | |
b642c0db | 78 | idx integer; |
adc5b4fb | 79 | binds integer[]; |
adc5b4fb JM |
80 | el integer; |
81 | fname varchar; | |
82 | args integer[]; | |
83 | result integer; | |
84 | BEGIN | |
494792ab JM |
85 | -- PERFORM writeline(format('EVAL: %s [%s]', pr_str(ast), ast)); |
86 | SELECT type_id INTO type FROM types.value WHERE value_id = ast; | |
adc5b4fb | 87 | IF type <> 8 THEN |
494792ab JM |
88 | RETURN mal.eval_ast(ast, env); |
89 | END IF; | |
90 | IF types._count(ast) = 0 THEN | |
91 | RETURN ast; | |
adc5b4fb JM |
92 | END IF; |
93 | ||
494792ab JM |
94 | a0 := types._first(ast); |
95 | IF types._symbol_Q(a0) THEN | |
96 | a0sym := (SELECT val_string FROM types.value WHERE value_id = a0); | |
adc5b4fb JM |
97 | ELSE |
98 | a0sym := '__<*fn*>__'; | |
99 | END IF; | |
100 | ||
adc5b4fb JM |
101 | CASE |
102 | WHEN a0sym = 'def!' THEN | |
103 | BEGIN | |
494792ab JM |
104 | RETURN envs.set(env, types._nth(ast, 1), |
105 | mal.EVAL(types._nth(ast, 2), env)); | |
adc5b4fb JM |
106 | END; |
107 | WHEN a0sym = 'let*' THEN | |
108 | BEGIN | |
494792ab JM |
109 | let_env := envs.new(env); |
110 | a1 := types._nth(ast, 1); | |
111 | binds := (SELECT val_seq FROM types.value WHERE value_id = a1); | |
b642c0db JM |
112 | idx := 1; |
113 | WHILE idx < array_length(binds, 1) LOOP | |
494792ab JM |
114 | PERFORM envs.set(let_env, binds[idx], |
115 | mal.EVAL(binds[idx+1], let_env)); | |
b642c0db | 116 | idx := idx + 2; |
adc5b4fb | 117 | END LOOP; |
494792ab | 118 | RETURN mal.EVAL(types._nth(ast, 2), let_env); |
adc5b4fb JM |
119 | END; |
120 | ELSE | |
121 | BEGIN | |
494792ab JM |
122 | el := mal.eval_ast(ast, env); |
123 | SELECT val_string INTO fname FROM types.value | |
124 | WHERE value_id = types._first(el); | |
125 | args := types._restArray(el); | |
adc5b4fb JM |
126 | EXECUTE format('SELECT %s($1);', fname) |
127 | INTO result USING args; | |
128 | RETURN result; | |
129 | END; | |
130 | END CASE; | |
131 | END; $$ LANGUAGE plpgsql; | |
132 | ||
133 | ||
494792ab | 134 | CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$ |
adc5b4fb | 135 | BEGIN |
494792ab | 136 | RETURN printer.pr_str(exp); |
adc5b4fb JM |
137 | END; $$ LANGUAGE plpgsql; |
138 | ||
139 | ||
140 | -- repl | |
141 | ||
494792ab | 142 | CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$ |
adc5b4fb JM |
143 | DECLARE a integer; b integer; result integer; |
144 | BEGIN | |
494792ab JM |
145 | SELECT val_int INTO a FROM types.value WHERE value_id = args[1]; |
146 | SELECT val_int INTO b FROM types.value WHERE value_id = args[2]; | |
147 | EXECUTE format('INSERT INTO types.value (type_id, val_int) | |
148 | VALUES (3, $1 %s $2) | |
adc5b4fb JM |
149 | RETURNING value_id;', op) INTO result USING a, b; |
150 | RETURN result; | |
151 | END; $$ LANGUAGE plpgsql; | |
152 | ||
494792ab JM |
153 | CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$ |
154 | BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql; | |
155 | CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$ | |
156 | BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql; | |
157 | CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$ | |
158 | BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql; | |
159 | CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$ | |
160 | BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql; | |
adc5b4fb | 161 | |
53105a77 | 162 | -- repl_env is environment 0 |
494792ab JM |
163 | INSERT INTO envs.env (env_id, outer_id, data) |
164 | VALUES (0, NULL, hstore(ARRAY['+', types._function('mal.add'), | |
165 | '-', types._function('mal.subtract'), | |
166 | '*', types._function('mal.multiply'), | |
167 | '/', types._function('mal.divide')])); | |
168 | ||
169 | CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$ | |
adc5b4fb | 170 | BEGIN |
494792ab | 171 | RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0)); |
adc5b4fb | 172 | END; $$ LANGUAGE plpgsql; |
53105a77 | 173 | |
494792ab | 174 | CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$ |
53105a77 | 175 | DECLARE |
494792ab JM |
176 | line varchar; |
177 | output varchar; | |
53105a77 JM |
178 | BEGIN |
179 | WHILE true | |
180 | LOOP | |
181 | BEGIN | |
494792ab JM |
182 | line := io.readline('user> ', 0); |
183 | IF line IS NULL THEN | |
184 | PERFORM io.close(1); | |
185 | RETURN 0; | |
186 | END IF; | |
187 | IF line NOT IN ('', E'\n') THEN | |
188 | output := mal.REP(line); | |
189 | PERFORM io.writeline(output); | |
53105a77 JM |
190 | END IF; |
191 | ||
192 | EXCEPTION WHEN OTHERS THEN | |
494792ab | 193 | PERFORM io.writeline('Error: ' || SQLERRM); |
53105a77 JM |
194 | END; |
195 | END LOOP; | |
196 | END; $$ LANGUAGE plpgsql; |