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 | ||
10 | FUNCTION MAIN(pwd varchar) RETURN integer; | |
11 | ||
12 | END mal; | |
13 | / | |
14 | ||
15 | CREATE OR REPLACE PACKAGE BODY mal IS | |
16 | ||
17 | FUNCTION MAIN(pwd varchar) RETURN integer IS | |
18 | M mem_type; | |
19 | env_mem env_mem_type; | |
20 | repl_env integer; | |
21 | x integer; | |
22 | line varchar2(4000); | |
23 | core_ns core_ns_type; | |
24 | cidx integer; | |
25 | ||
26 | -- read | |
27 | FUNCTION READ(line varchar) RETURN integer IS | |
28 | BEGIN | |
29 | RETURN reader.read_str(M, line); | |
30 | END; | |
31 | ||
32 | -- eval | |
33 | ||
34 | -- forward declarations | |
35 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer; | |
36 | ||
37 | FUNCTION eval_ast(ast integer, env integer) RETURN integer IS | |
38 | i integer; | |
39 | old_seq mal_seq_items_type; | |
40 | new_seq mal_seq_items_type; | |
41 | BEGIN | |
42 | IF M(ast).type_id = 7 THEN | |
43 | RETURN env_pkg.env_get(M, env_mem, env, ast); | |
44 | ELSIF M(ast).type_id IN (8,9) THEN | |
45 | old_seq := TREAT(M(ast) AS mal_seq_type).val_seq; | |
46 | new_seq := mal_seq_items_type(); | |
47 | new_seq.EXTEND(old_seq.COUNT); | |
48 | FOR i IN 1..old_seq.COUNT LOOP | |
49 | new_seq(i) := EVAL(old_seq(i), env); | |
50 | END LOOP; | |
51 | RETURN types.seq(M, M(ast).type_id, new_seq); | |
52 | ELSE | |
53 | RETURN ast; | |
54 | END IF; | |
55 | END; | |
56 | ||
57 | FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS | |
58 | ast integer := orig_ast; | |
59 | env integer := orig_env; | |
60 | el integer; | |
61 | a0 integer; | |
150011e4 | 62 | a0sym varchar2(100); |
0fc03918 JM |
63 | seq mal_seq_items_type; |
64 | let_env integer; | |
65 | i integer; | |
66 | f integer; | |
67 | cond integer; | |
68 | malfn malfunc_type; | |
150011e4 | 69 | args mal_seq_items_type; |
0fc03918 JM |
70 | BEGIN |
71 | WHILE TRUE LOOP | |
72 | IF M(ast).type_id <> 8 THEN | |
73 | RETURN eval_ast(ast, env); | |
74 | END IF; | |
75 | ||
76 | -- apply | |
77 | a0 := types.first(M, ast); | |
78 | if M(a0).type_id = 7 THEN -- symbol | |
79 | a0sym := TREAT(M(a0) AS mal_str_type).val_str; | |
80 | ELSE | |
81 | a0sym := '__<*fn*>__'; | |
82 | END IF; | |
83 | ||
84 | CASE | |
85 | WHEN a0sym = 'def!' THEN | |
86 | RETURN env_pkg.env_set(M, env_mem, env, | |
87 | types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env)); | |
88 | WHEN a0sym = 'let*' THEN | |
89 | let_env := env_pkg.env_new(M, env_mem, env); | |
90 | seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_type).val_seq; | |
91 | i := 1; | |
92 | WHILE i <= seq.COUNT LOOP | |
93 | x := env_pkg.env_set(M, env_mem, let_env, | |
94 | seq(i), EVAL(seq(i+1), let_env)); | |
95 | i := i + 2; | |
96 | END LOOP; | |
97 | env := let_env; | |
98 | ast := types.nth(M, ast, 2); -- TCO | |
99 | WHEN a0sym = 'do' THEN | |
100 | x := types.slice(M, ast, 1, types.count(M, ast)-2); | |
101 | x := eval_ast(x, env); | |
102 | ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO | |
103 | WHEN a0sym = 'if' THEN | |
104 | cond := EVAL(types.nth(M, ast, 1), env); | |
105 | IF cond = 1 OR cond = 2 THEN -- nil or false | |
106 | IF types.count(M, ast) > 3 THEN | |
107 | ast := EVAL(types.nth(M, ast, 3), env); -- TCO | |
108 | ELSE | |
109 | RETURN 1; -- nil | |
110 | END IF; | |
111 | ELSE | |
112 | ast := EVAL(types.nth(M, ast, 2), env); -- TCO | |
113 | END IF; | |
114 | WHEN a0sym = 'fn*' THEN | |
115 | RETURN types.malfunc(M, types.nth(M, ast, 2), | |
116 | types.nth(M, ast, 1), | |
117 | env); | |
118 | ELSE | |
119 | el := eval_ast(ast, env); | |
120 | f := types.first(M, el); | |
150011e4 | 121 | args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_type).val_seq; |
0fc03918 JM |
122 | IF M(f).type_id = 12 THEN |
123 | malfn := TREAT(M(f) AS malfunc_type); | |
124 | env := env_pkg.env_new(M, env_mem, malfn.env, | |
125 | malfn.params, args); | |
126 | ast := malfn.ast; -- TCO | |
127 | ELSE | |
150011e4 | 128 | RETURN core.do_core_func(M, f, args); |
0fc03918 JM |
129 | END IF; |
130 | END CASE; | |
131 | ||
132 | END LOOP; | |
133 | ||
134 | END; | |
135 | ||
136 | ||
137 | FUNCTION PRINT(exp integer) RETURN varchar IS | |
138 | BEGIN | |
139 | RETURN printer.pr_str(M, exp); | |
140 | END; | |
141 | ||
142 | -- repl | |
143 | FUNCTION REP(line varchar) RETURN varchar IS | |
144 | BEGIN | |
145 | RETURN PRINT(EVAL(READ(line), repl_env)); | |
146 | END; | |
147 | ||
148 | BEGIN | |
149 | M := types.mem_new(); | |
150 | env_mem := env_mem_type(); | |
151 | ||
152 | repl_env := env_pkg.env_new(M, env_mem, NULL); | |
153 | ||
154 | -- core.EXT: defined using PL/SQL | |
155 | core_ns := core.get_core_ns(); | |
156 | FOR cidx IN 1..core_ns.COUNT LOOP | |
157 | x := env_pkg.env_set(M, env_mem, repl_env, | |
158 | types.symbol(M, core_ns(cidx)), | |
159 | types.func(M, core_ns(cidx))); | |
160 | END LOOP; | |
161 | ||
162 | -- core.mal: defined using the language itself | |
163 | line := REP('(def! not (fn* (a) (if a false true)))'); | |
164 | ||
165 | WHILE true LOOP | |
166 | BEGIN | |
167 | line := stream_readline('user> ', 0); | |
168 | IF line IS NULL THEN CONTINUE; END IF; | |
169 | IF line IS NOT NULL THEN | |
170 | stream_writeline(REP(line)); | |
171 | END IF; | |
172 | ||
173 | EXCEPTION WHEN OTHERS THEN | |
150011e4 | 174 | IF SQLCODE = -20001 THEN -- io streams closed |
0fc03918 JM |
175 | RETURN 0; |
176 | END IF; | |
177 | stream_writeline('Error: ' || SQLERRM); | |
178 | stream_writeline(dbms_utility.format_error_backtrace); | |
179 | END; | |
180 | END LOOP; | |
181 | END; | |
182 | ||
183 | END mal; | |
184 | / | |
185 | show errors; | |
186 | ||
187 | quit; |