Commit | Line | Data |
---|---|---|
33a37291 DM |
1 | /* Save command-line arguments from the top-level program before entering a procedure */ |
2 | command_line_args. = "" | |
3 | command_line_args.0 = arg() | |
4 | do i=1 to command_line_args.0 | |
5 | command_line_args.i = arg(i) | |
6 | end | |
7 | ||
8 | call main | |
9 | exit | |
10 | ||
11 | #include "readline.rexx" | |
12 | #include "reader.rexx" | |
13 | #include "printer.rexx" | |
14 | #include "types.rexx" | |
15 | #include "env.rexx" | |
16 | #include "core.rexx" | |
17 | ||
18 | read: procedure expose values. err /* read(str) */ | |
19 | return read_str(arg(1)) | |
20 | ||
21 | eval_ast: procedure expose values. env. err /* eval_ast(ast, env_idx) */ | |
22 | ast = arg(1) | |
23 | env_idx = arg(2) | |
24 | type = obj_type(ast) | |
25 | val = obj_val(ast) | |
26 | select | |
27 | when type == "symb" then return env_get(env_idx, val) | |
28 | when type == "list" then do | |
29 | res = "" | |
30 | do i=1 to words(val) | |
31 | element = eval(word(val, i), env_idx) | |
32 | if element == "ERR" then return "ERR" | |
33 | if i > 1 then | |
34 | res = res || " " || element | |
35 | else | |
36 | res = element | |
37 | end | |
38 | return new_list(res) | |
39 | end | |
40 | when type == "vect" then do | |
41 | res = "" | |
42 | do i=1 to words(val) | |
43 | element = eval(word(val, i), env_idx) | |
44 | if element == "ERR" then return "ERR" | |
45 | if i > 1 then | |
46 | res = res || " " || element | |
47 | else | |
48 | res = element | |
49 | end | |
50 | return new_vector(res) | |
51 | end | |
52 | when type == "hash" then do | |
53 | res = "" | |
54 | do i=1 to words(val) | |
55 | element = eval(word(val, i), env_idx) | |
56 | if element == "ERR" then return "ERR" | |
57 | if i > 1 then | |
58 | res = res || " " || element | |
59 | else | |
60 | res = element | |
61 | end | |
62 | return new_hashmap(res) | |
63 | end | |
64 | otherwise | |
65 | return ast | |
66 | end | |
67 | ||
68 | eval: procedure expose values. env. err /* eval(ast) */ | |
69 | ast = arg(1) | |
70 | env_idx = arg(2) | |
71 | do forever | |
72 | if \list?(ast) then return eval_ast(ast, env_idx) | |
73 | astval = obj_val(ast) | |
74 | if words(astval) == 0 then return ast | |
75 | a0sym = obj_val(word(astval, 1)) | |
76 | select | |
77 | when a0sym == "def!" then do | |
78 | a1sym = obj_val(word(astval, 2)) | |
79 | a2 = eval(word(astval, 3), env_idx) | |
80 | if a2 == "ERR" then return "ERR" | |
81 | return env_set(env_idx, a1sym, a2) | |
82 | end | |
83 | when a0sym == "let*" then do | |
84 | a1lst = obj_val(word(astval, 2)) | |
85 | letenv_idx = new_env(env_idx) | |
86 | do i=1 to words(a1lst) by 2 | |
87 | k = obj_val(word(a1lst, i)) | |
88 | v = eval(word(a1lst, i + 1), letenv_idx) | |
89 | if v == "ERR" then return "ERR" | |
90 | unused = env_set(letenv_idx, k, v) | |
91 | end | |
92 | env_idx = letenv_idx | |
93 | ast = word(astval, 3) | |
94 | /* TCO */ | |
95 | end | |
96 | when a0sym == "do" then do | |
97 | do i=2 to (words(astval) - 1) | |
98 | res = eval(word(astval, i), env_idx) | |
99 | if res == "ERR" then return "ERR" | |
100 | end | |
101 | ast = word(astval, words(astval)) | |
102 | /* TCO */ | |
103 | end | |
104 | when a0sym == "if" then do | |
105 | condval = eval(word(astval, 2), env_idx) | |
106 | if false?(condval) | nil?(condval) then | |
107 | if words(astval) >= 4 then | |
108 | ast = word(astval, 4) | |
109 | else | |
110 | return new_nil() | |
111 | else | |
112 | ast = word(astval, 3) | |
113 | /* TCO */ | |
114 | end | |
115 | when a0sym == "fn*" then return new_func(word(astval, 3), env_idx, word(astval, 2)) | |
116 | otherwise | |
117 | lst_obj = eval_ast(ast, env_idx) | |
118 | if lst_obj == "ERR" then return "ERR" | |
119 | lst = obj_val(lst_obj) | |
120 | f = word(lst, 1) | |
121 | select | |
122 | when nativefn?(f) then do | |
123 | call_args = subword(lst, 2) | |
124 | call_list = "" | |
125 | do i=1 to words(call_args) | |
126 | element = '"' || word(call_args, i) || '"' | |
127 | if i > 1 then | |
128 | call_list = call_list || ', ' || element | |
129 | else | |
130 | call_list = element | |
131 | end | |
132 | res = "" | |
133 | interpret "res = " || obj_val(f) || "(" || call_list || ")" | |
134 | return res | |
135 | end | |
136 | when func?(f) then do | |
137 | call_args = new_list(subword(lst, 2)) | |
138 | env_idx = new_env(func_env_idx(f), func_binds(f), call_args) | |
139 | ast = func_body_ast(f) | |
140 | /* TCO */ | |
141 | end | |
142 | otherwise | |
143 | err = "Unsupported function object type: " || obj_type(f) | |
144 | return "ERR" | |
145 | end | |
146 | end | |
147 | end | |
148 | ||
149 | print: procedure expose values. /* print(ast) */ | |
150 | return pr_str(arg(1), 1) | |
151 | ||
152 | re: procedure expose values. env. err repl_env_idx /* re(str) */ | |
153 | str = arg(1) | |
154 | ast = read(str) | |
155 | if ast == "ERR" then return "ERR" | |
156 | return eval(ast, repl_env_idx) | |
157 | ||
158 | rep: procedure expose values. env. err repl_env_idx /* rep(str) */ | |
159 | str = arg(1) | |
160 | exp = re(str) | |
161 | if exp == "ERR" then return "ERR" | |
162 | return print(exp) | |
163 | ||
164 | mal_eval: procedure expose values. env. err /* mal_eval(ast) */ | |
165 | ast = arg(1) | |
166 | if ast == "ERR" then return "ERR" | |
167 | return eval(arg(1), 1) /* repl_env_idx is always 1 because it's the first env */ | |
168 | ||
169 | build_args_list: procedure expose values. command_line_args. /* build_args_list() */ | |
170 | seq = "" | |
171 | do i=2 to command_line_args.0 | |
172 | s = new_string(command_line_args.i) | |
173 | if i == 1 then | |
174 | seq = s | |
175 | else | |
176 | seq = seq || " " || s | |
177 | end | |
178 | return new_list(seq) | |
179 | ||
180 | main: | |
181 | values. = "" | |
182 | values.0 = 0 | |
183 | env. = "" | |
184 | env.0 = 0 | |
185 | repl_env_idx = new_env(0) | |
186 | ||
187 | /* core.rexx: defined using Rexx */ | |
188 | core_ns = get_core_ns() | |
189 | do i=1 to words(core_ns) by 2 | |
190 | x = env_set(repl_env_idx, word(core_ns, i), new_nativefn(word(core_ns, i + 1))) | |
191 | end | |
192 | x = env_set(repl_env_idx, "eval", new_nativefn("mal_eval")) | |
193 | x = env_set(repl_env_idx, "*ARGV*", build_args_list()) | |
194 | ||
195 | /* core.mal: defined using the language itself */ | |
196 | x = re("(def! not (fn* (a) (if a false true)))") | |
e6d41de4 | 197 | x = re('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))') |
33a37291 DM |
198 | |
199 | err = "" | |
200 | if command_line_args.0 > 0 then do | |
201 | x = re('(load-file "' || command_line_args.1 || '")') | |
202 | return | |
203 | end | |
204 | ||
205 | do while lines() > 0 /* 1 == 1 */ | |
206 | input_line = readline('user> ') | |
207 | if length(input_line) > 0 then do | |
208 | res = rep(input_line) | |
209 | if res == "ERR" then | |
210 | call lineout , "Error: " || err | |
211 | else | |
212 | call lineout , res | |
213 | end | |
214 | end |