Merge pull request #345 from asarhaddon/ada.2
[jackhill/mal.git] / plpgsql / step3_env.sql
CommitLineData
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
13CREATE SCHEMA mal;
adc5b4fb
JM
14
15-- read
494792ab 16CREATE FUNCTION mal.READ(line varchar) RETURNS integer AS $$
adc5b4fb 17BEGIN
494792ab 18 RETURN reader.read_str(line);
adc5b4fb
JM
19END; $$ LANGUAGE plpgsql;
20
21-- eval
494792ab 22CREATE FUNCTION mal.eval_ast(ast integer, env integer) RETURNS integer AS $$
adc5b4fb
JM
23DECLARE
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;
32BEGIN
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;
69END; $$ LANGUAGE plpgsql;
70
494792ab 71CREATE FUNCTION mal.EVAL(ast integer, env integer) RETURNS integer AS $$
adc5b4fb
JM
72DECLARE
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;
84BEGIN
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;
131END; $$ LANGUAGE plpgsql;
132
133-- print
494792ab 134CREATE FUNCTION mal.PRINT(exp integer) RETURNS varchar AS $$
adc5b4fb 135BEGIN
494792ab 136 RETURN printer.pr_str(exp);
adc5b4fb
JM
137END; $$ LANGUAGE plpgsql;
138
139
140-- repl
141
494792ab 142CREATE FUNCTION mal.intop(op varchar, args integer[]) RETURNS integer AS $$
adc5b4fb
JM
143DECLARE a integer; b integer; result integer;
144BEGIN
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;
151END; $$ LANGUAGE plpgsql;
152
494792ab
JM
153CREATE FUNCTION mal.add(args integer[]) RETURNS integer AS $$
154BEGIN RETURN mal.intop('+', args); END; $$ LANGUAGE plpgsql;
155CREATE FUNCTION mal.subtract(args integer[]) RETURNS integer AS $$
156BEGIN RETURN mal.intop('-', args); END; $$ LANGUAGE plpgsql;
157CREATE FUNCTION mal.multiply(args integer[]) RETURNS integer AS $$
158BEGIN RETURN mal.intop('*', args); END; $$ LANGUAGE plpgsql;
159CREATE FUNCTION mal.divide(args integer[]) RETURNS integer AS $$
160BEGIN RETURN mal.intop('/', args); END; $$ LANGUAGE plpgsql;
adc5b4fb 161
53105a77 162-- repl_env is environment 0
494792ab
JM
163INSERT 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
169CREATE FUNCTION mal.REP(line varchar) RETURNS varchar AS $$
adc5b4fb 170BEGIN
494792ab 171 RETURN mal.PRINT(mal.EVAL(mal.READ(line), 0));
adc5b4fb 172END; $$ LANGUAGE plpgsql;
53105a77 173
494792ab 174CREATE FUNCTION mal.MAIN(pwd varchar) RETURNS integer AS $$
53105a77 175DECLARE
494792ab
JM
176 line varchar;
177 output varchar;
53105a77
JM
178BEGIN
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;
196END; $$ LANGUAGE plpgsql;