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