Commit | Line | Data |
---|---|---|
0fc03918 JM |
1 | @io.sql |
2 | @types.sql | |
3 | @reader.sql | |
4 | @printer.sql | |
5 | @env.sql | |
6 | @core.sql | |
7 | ||
8 | CREATE OR REPLACE PACKAGE mal IS | |
9 | ||
10cc781f | 10 | FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer; |
0fc03918 JM |
11 | |
12 | END mal; | |
13 | / | |
14 | ||
15 | CREATE OR REPLACE PACKAGE BODY mal IS | |
16 | ||
10cc781f | 17 | FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS |
2866f9a8 | 18 | M types.mal_table; -- general mal value memory pool |
6a085103 JM |
19 | H types.map_entry_table; -- hashmap memory pool |
20 | E env_pkg.env_entry_table; -- mal env memory pool | |
0fc03918 JM |
21 | repl_env integer; |
22 | x integer; | |
02936b42 | 23 | line CLOB; |
2866f9a8 | 24 | core_ns core_ns_T; |
0fc03918 JM |
25 | cidx integer; |
26 | ||
27 | -- read | |
28 | FUNCTION READ(line varchar) RETURN integer IS | |
29 | BEGIN | |
6a085103 | 30 | RETURN reader.read_str(M, H, line); |
0fc03918 JM |
31 | END; |
32 | ||
33 | -- eval | |
34 | ||
35 | -- forward declarations | |
36 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; | |
37 | ||
38 | FUNCTION eval_ast(ast integer, env integer) RETURN integer IS | |
6a085103 | 39 | i integer; |
2866f9a8 JM |
40 | old_seq mal_vals; |
41 | new_seq mal_vals; | |
6a085103 JM |
42 | new_hm integer; |
43 | old_midx integer; | |
44 | new_midx integer; | |
45 | k varchar2(256); | |
0fc03918 JM |
46 | BEGIN |
47 | IF M(ast).type_id = 7 THEN | |
10cc781f | 48 | RETURN env_pkg.env_get(M, E, env, ast); |
0fc03918 | 49 | ELSIF M(ast).type_id IN (8,9) THEN |
2866f9a8 JM |
50 | old_seq := TREAT(M(ast) AS mal_seq_T).val_seq; |
51 | new_seq := mal_vals(); | |
0fc03918 JM |
52 | new_seq.EXTEND(old_seq.COUNT); |
53 | FOR i IN 1..old_seq.COUNT LOOP | |
54 | new_seq(i) := EVAL(old_seq(i), env); | |
55 | END LOOP; | |
56 | RETURN types.seq(M, M(ast).type_id, new_seq); | |
6a085103 | 57 | ELSIF M(ast).type_id IN (10) THEN |
2866f9a8 JM |
58 | new_hm := types.hash_map(M, H, mal_vals()); |
59 | old_midx := TREAT(M(ast) AS mal_map_T).map_idx; | |
60 | new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx; | |
6a085103 JM |
61 | |
62 | k := H(old_midx).FIRST(); | |
63 | WHILE k IS NOT NULL LOOP | |
64 | H(new_midx)(k) := EVAL(H(old_midx)(k), env); | |
65 | k := H(old_midx).NEXT(k); | |
66 | END LOOP; | |
67 | RETURN new_hm; | |
0fc03918 JM |
68 | ELSE |
69 | RETURN ast; | |
70 | END IF; | |
71 | END; | |
72 | ||
73 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS | |
74 | ast integer := orig_ast; | |
75 | env integer := orig_env; | |
76 | el integer; | |
77 | a0 integer; | |
150011e4 | 78 | a0sym varchar2(100); |
2866f9a8 | 79 | seq mal_vals; |
0fc03918 JM |
80 | let_env integer; |
81 | i integer; | |
82 | f integer; | |
83 | cond integer; | |
2866f9a8 JM |
84 | malfn mal_func_T; |
85 | args mal_vals; | |
0fc03918 JM |
86 | BEGIN |
87 | WHILE TRUE LOOP | |
2866f9a8 | 88 | -- io.writeline('EVAL: ' || printer.pr_str(M, ast)); |
0fc03918 JM |
89 | IF M(ast).type_id <> 8 THEN |
90 | RETURN eval_ast(ast, env); | |
91 | END IF; | |
6a085103 JM |
92 | IF types.count(M, ast) = 0 THEN |
93 | RETURN ast; -- empty list just returned | |
94 | END IF; | |
0fc03918 JM |
95 | |
96 | -- apply | |
97 | a0 := types.first(M, ast); | |
98 | if M(a0).type_id = 7 THEN -- symbol | |
2866f9a8 | 99 | a0sym := TREAT(M(a0) AS mal_str_T).val_str; |
0fc03918 JM |
100 | ELSE |
101 | a0sym := '__<*fn*>__'; | |
102 | END IF; | |
103 | ||
104 | CASE | |
105 | WHEN a0sym = 'def!' THEN | |
10cc781f | 106 | RETURN env_pkg.env_set(M, E, env, |
0fc03918 JM |
107 | types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); |
108 | WHEN a0sym = 'let*' THEN | |
10cc781f | 109 | let_env := env_pkg.env_new(M, E, env); |
2866f9a8 | 110 | seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq; |
0fc03918 JM |
111 | i := 1; |
112 | WHILE i <= seq.COUNT LOOP | |
10cc781f | 113 | x := env_pkg.env_set(M, E, let_env, |
0fc03918 JM |
114 | seq(i), EVAL(seq(i+1), let_env)); |
115 | i := i + 2; | |
116 | END LOOP; | |
117 | env := let_env; | |
118 | ast := types.nth(M, ast, 2); -- TCO | |
119 | WHEN a0sym = 'do' THEN | |
120 | x := types.slice(M, ast, 1, types.count(M, ast)-2); | |
121 | x := eval_ast(x, env); | |
122 | ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO | |
123 | WHEN a0sym = 'if' THEN | |
124 | cond := EVAL(types.nth(M, ast, 1), env); | |
125 | IF cond = 1 OR cond = 2 THEN -- nil or false | |
126 | IF types.count(M, ast) > 3 THEN | |
6a085103 | 127 | ast := types.nth(M, ast, 3); -- TCO |
0fc03918 JM |
128 | ELSE |
129 | RETURN 1; -- nil | |
130 | END IF; | |
131 | ELSE | |
6a085103 | 132 | ast := types.nth(M, ast, 2); -- TCO |
0fc03918 JM |
133 | END IF; |
134 | WHEN a0sym = 'fn*' THEN | |
135 | RETURN types.malfunc(M, types.nth(M, ast, 2), | |
136 | types.nth(M, ast, 1), | |
137 | env); | |
138 | ELSE | |
139 | el := eval_ast(ast, env); | |
140 | f := types.first(M, el); | |
2866f9a8 | 141 | args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq; |
0fc03918 | 142 | IF M(f).type_id = 12 THEN |
2866f9a8 | 143 | malfn := TREAT(M(f) AS mal_func_T); |
10cc781f | 144 | env := env_pkg.env_new(M, E, malfn.env, |
0fc03918 JM |
145 | malfn.params, args); |
146 | ast := malfn.ast; -- TCO | |
147 | ELSE | |
6a085103 | 148 | RETURN core.do_core_func(M, H, f, args); |
0fc03918 JM |
149 | END IF; |
150 | END CASE; | |
151 | ||
152 | END LOOP; | |
153 | ||
154 | END; | |
155 | ||
156 | ||
157 | FUNCTION PRINT(exp integer) RETURN varchar IS | |
158 | BEGIN | |
6a085103 | 159 | RETURN printer.pr_str(M, H, exp); |
0fc03918 JM |
160 | END; |
161 | ||
162 | -- repl | |
163 | FUNCTION REP(line varchar) RETURN varchar IS | |
164 | BEGIN | |
165 | RETURN PRINT(EVAL(READ(line), repl_env)); | |
166 | END; | |
167 | ||
168 | BEGIN | |
6a085103 | 169 | -- initialize memory pools |
0fc03918 | 170 | M := types.mem_new(); |
6a085103 | 171 | H := types.map_entry_table(); |
10cc781f | 172 | E := env_pkg.env_entry_table(); |
0fc03918 | 173 | |
10cc781f | 174 | repl_env := env_pkg.env_new(M, E, NULL); |
0fc03918 JM |
175 | |
176 | -- core.EXT: defined using PL/SQL | |
177 | core_ns := core.get_core_ns(); | |
178 | FOR cidx IN 1..core_ns.COUNT LOOP | |
10cc781f | 179 | x := env_pkg.env_set(M, E, repl_env, |
0fc03918 JM |
180 | types.symbol(M, core_ns(cidx)), |
181 | types.func(M, core_ns(cidx))); | |
182 | END LOOP; | |
183 | ||
184 | -- core.mal: defined using the language itself | |
185 | line := REP('(def! not (fn* (a) (if a false true)))'); | |
186 | ||
187 | WHILE true LOOP | |
188 | BEGIN | |
02936b42 JM |
189 | line := io.readline('user> ', 0); |
190 | IF line = EMPTY_CLOB() THEN CONTINUE; END IF; | |
0fc03918 | 191 | IF line IS NOT NULL THEN |
02936b42 | 192 | io.writeline(REP(line)); |
0fc03918 JM |
193 | END IF; |
194 | ||
195 | EXCEPTION WHEN OTHERS THEN | |
8119e744 JM |
196 | IF SQLCODE = -20001 THEN -- io read stream closed |
197 | io.close(1); -- close output stream | |
0fc03918 JM |
198 | RETURN 0; |
199 | END IF; | |
02936b42 JM |
200 | io.writeline('Error: ' || SQLERRM); |
201 | io.writeline(dbms_utility.format_error_backtrace); | |
0fc03918 JM |
202 | END; |
203 | END LOOP; | |
204 | END; | |
205 | ||
206 | END mal; | |
207 | / | |
208 | show errors; | |
209 | ||
210 | quit; |