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