8 CREATE OR REPLACE PACKAGE mal
IS
10 FUNCTION MAIN(args
varchar DEFAULT '()') RETURN integer;
15 CREATE OR REPLACE PACKAGE BODY mal
IS
17 FUNCTION MAIN(args
varchar DEFAULT '()') RETURN integer IS
18 M types.mal_table
; -- general mal value memory pool
19 H types.map_entry_table
; -- hashmap memory pool
20 E env_pkg.env_entry_table
; -- mal env memory pool
28 FUNCTION READ(line
varchar) RETURN integer IS
30 RETURN reader.
read_str(M
, H
, line
);
35 -- forward declarations
36 FUNCTION EVAL(orig_ast
integer, orig_env
integer) RETURN integer;
38 FUNCTION eval_ast(ast
integer, env
integer) RETURN integer IS
47 IF M(ast
).type_id
= 7 THEN
48 RETURN env_pkg.
env_get(M
, E
, env
, ast
);
49 ELSIF
M(ast
).type_id
IN (8,9) THEN
50 old_seq
:= TREAT(M(ast
) AS mal_seq_T
).val_seq
;
51 new_seq
:= mal_vals();
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
);
56 RETURN types.
seq(M
, M(ast
).type_id
, new_seq
);
57 ELSIF
M(ast
).type_id
IN (10) THEN
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
;
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
);
73 FUNCTION EVAL(orig_ast
integer, orig_env
integer) RETURN integer IS
74 ast
integer := orig_ast
;
75 env
integer := orig_env
;
88 -- io.writeline('EVAL: ' || printer.pr_str(M, ast));
89 IF M(ast
).type_id
<> 8 THEN
90 RETURN eval_ast(ast
, env
);
92 IF types.
count(M
, ast
) = 0 THEN
93 RETURN ast
; -- empty list just returned
97 a0
:= types.
first(M
, ast
);
98 if M(a0
).type_id
= 7 THEN -- symbol
99 a0sym
:= TREAT(M(a0
) AS mal_str_T
).val_str
;
101 a0sym
:= '__<*fn*>__';
105 WHEN a0sym
= 'def!' THEN
106 RETURN env_pkg.
env_set(M
, E
, env
,
107 types.
nth(M
, ast
, 1), EVAL(types.
nth(M
, ast
, 2), env
));
108 WHEN a0sym
= 'let*' THEN
109 let_env
:= env_pkg.
env_new(M
, E
, env
);
110 seq
:= TREAT(M(types.
nth(M
, ast
, 1)) AS mal_seq_T
).val_seq
;
112 WHILE i
<= seq.
COUNT LOOP
113 x
:= env_pkg.
env_set(M
, E
, let_env
,
114 seq(i
), EVAL(seq(i
+1), 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
127 ast
:= types.
nth(M
, ast
, 3); -- TCO
132 ast
:= types.
nth(M
, ast
, 2); -- TCO
134 WHEN a0sym
= 'fn*' THEN
135 RETURN types.
malfunc(M
, types.
nth(M
, ast
, 2),
136 types.
nth(M
, ast
, 1),
139 el
:= eval_ast(ast
, env
);
140 f
:= types.
first(M
, el
);
141 args
:= TREAT(M(types.
slice(M
, el
, 1)) AS mal_seq_T
).val_seq
;
142 IF M(f
).type_id
= 12 THEN
143 malfn
:= TREAT(M(f
) AS mal_func_T
);
144 env
:= env_pkg.
env_new(M
, E
, malfn.env
,
146 ast
:= malfn.ast
; -- TCO
148 RETURN core.
do_core_func(M
, H
, f
, args
);
157 FUNCTION PRINT(exp integer) RETURN varchar IS
159 RETURN printer.
pr_str(M
, H
, exp);
163 FUNCTION REP(line
varchar) RETURN varchar IS
165 RETURN PRINT(EVAL(READ(line
), repl_env
));
169 -- initialize memory pools
170 M
:= types.
mem_new();
171 H
:= types.
map_entry_table();
172 E
:= env_pkg.
env_entry_table();
174 repl_env
:= env_pkg.
env_new(M
, E
, NULL);
176 -- core.EXT: defined using PL/SQL
177 core_ns
:= core.
get_core_ns();
178 FOR cidx
IN 1..core_ns.
COUNT LOOP
179 x
:= env_pkg.
env_set(M
, E
, repl_env
,
180 types.
symbol(M
, core_ns(cidx
)),
181 types.
func(M
, core_ns(cidx
)));
184 -- core.mal: defined using the language itself
185 line
:= REP('(def! not (fn* (a) (if a false true)))');
189 line
:= io.
readline('user> ', 0);
190 IF line
= EMPTY_CLOB() THEN CONTINUE; END IF;
191 IF line
IS NOT NULL THEN
192 io.
writeline(REP(line
));
195 EXCEPTION WHEN OTHERS THEN
196 IF SQLCODE = -20001 THEN -- io read stream closed
197 io.
close(1); -- close output stream
200 io.
writeline('Error: ' || SQLERRM
);
201 io.
writeline(dbms_utility.format_error_backtrace
);