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