Commit | Line | Data |
---|---|---|
7cae6e6f JM |
1 | #import <Foundation/Foundation.h> |
2 | ||
3 | #import "mal_readline.h" | |
4 | #import "types.h" | |
5 | #import "reader.h" | |
6 | #import "printer.h" | |
7 | #import "env.h" | |
8 | #import "malfunc.h" | |
9 | #import "core.h" | |
10 | ||
11 | // read | |
12 | NSObject *READ(NSString *str) { | |
13 | return read_str(str); | |
14 | } | |
15 | ||
16 | // eval | |
17 | BOOL is_pair(NSObject *obj) { | |
18 | return [obj isKindOfClass:[NSArray class]] && | |
19 | [(NSArray *)obj count] > 0; | |
20 | } | |
21 | ||
22 | NSObject * quasiquote(NSObject *ast) { | |
23 | if (!is_pair(ast)) { | |
24 | return @[[MalSymbol stringWithString:@"quote"], ast]; | |
25 | } else { | |
26 | NSArray * alst = (NSArray *)ast; | |
27 | id a0 = alst[0]; | |
28 | if ([a0 isKindOfClass:[MalSymbol class]] && | |
29 | [(NSString *)a0 isEqualTo:@"unquote"]) { | |
30 | return alst[1]; | |
31 | } else if (is_pair(a0)) { | |
32 | id a0lst = (NSArray *)a0; | |
33 | id a00 = a0lst[0]; | |
34 | if ([a00 isKindOfClass:[MalSymbol class]] && | |
35 | [(NSString *)a00 isEqualTo:@"splice-unquote"]) { | |
36 | return @[[MalSymbol stringWithString:@"concat"], | |
37 | a0lst[1], | |
38 | quasiquote(_rest(alst))]; | |
39 | } | |
40 | } | |
41 | return @[[MalSymbol stringWithString:@"cons"], | |
42 | quasiquote(a0), | |
43 | quasiquote(_rest(alst))]; | |
44 | } | |
45 | } | |
46 | ||
47 | NSObject *eval_ast(NSObject *ast, Env *env) { | |
48 | if ([ast isMemberOfClass:[MalSymbol class]]) { | |
49 | return [env get:(MalSymbol *)ast]; | |
50 | } else if ([ast isKindOfClass:[NSArray class]]) { | |
51 | NSMutableArray *newLst = [NSMutableArray array]; | |
52 | for (NSObject * x in (NSArray *)ast) { | |
53 | [newLst addObject:EVAL(x, env)]; | |
54 | } | |
55 | if ([ast isKindOfClass:[MalVector class]]) { | |
56 | return [MalVector fromArray:newLst]; | |
57 | } else { | |
58 | return newLst; | |
59 | } | |
60 | } else if ([ast isKindOfClass:[NSDictionary class]]) { | |
61 | NSMutableDictionary *newDict = [NSMutableDictionary dictionary]; | |
62 | for (NSString * k in (NSDictionary *)ast) { | |
63 | newDict[k] = EVAL(((NSDictionary *)ast)[k], env); | |
64 | } | |
65 | return newDict; | |
66 | } else { | |
67 | return ast; | |
68 | } | |
69 | } | |
70 | ||
71 | NSObject *EVAL(NSObject *ast, Env *env) { | |
72 | while (true) { | |
73 | //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env); | |
74 | if (!list_Q(ast)) { | |
75 | return eval_ast(ast, env); | |
76 | } | |
77 | ||
203e9599 JM |
78 | // apply list |
79 | if ([(NSArray *)ast count] == 0) { | |
80 | return ast; | |
81 | } | |
7cae6e6f JM |
82 | NSArray * alst = (NSArray *)ast; |
83 | id a0 = alst[0]; | |
84 | NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0 | |
85 | : @"__<*fn*>__"; | |
86 | ||
87 | if ([a0sym isEqualTo:@"def!"]) { | |
88 | return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)]; | |
89 | } else if ([(NSString *)a0 isEqualTo:@"let*"]) { | |
90 | Env *let_env = [Env fromOuter:env]; | |
91 | NSArray * binds = (NSArray *)alst[1]; | |
92 | for (int i=0; i < [binds count]; i+=2) { | |
93 | [let_env set:binds[i] val:EVAL(binds[i+1], let_env)]; | |
94 | } | |
95 | env = let_env; | |
96 | ast = alst[2]; // TCO | |
97 | } else if ([(NSString *)a0 isEqualTo:@"quote"]) { | |
98 | return alst[1]; | |
99 | } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) { | |
100 | ast = quasiquote(alst[1]); // TCO | |
101 | } else if ([a0sym isEqualTo:@"do"]) { | |
102 | NSRange r = NSMakeRange(1, [alst count] - 2); | |
103 | eval_ast([alst subarrayWithRange:r], env); | |
104 | ast = [alst lastObject]; // TCO | |
105 | } else if ([a0sym isEqualTo:@"if"]) { | |
106 | NSObject * cond = EVAL(alst[1], env); | |
107 | if ([cond isKindOfClass:[NSNull class]] || | |
108 | [cond isKindOfClass:[MalFalse class]]) { | |
109 | if ([alst count] > 3) { | |
110 | ast = alst[3]; // TCO | |
111 | } else { | |
112 | return [NSNull alloc]; | |
113 | } | |
114 | } else { | |
115 | ast = alst[2]; // TCO | |
116 | } | |
117 | } else if ([a0sym isEqualTo:@"fn*"]) { | |
118 | return [[MalFunc alloc] init:alst[2] env:env params:alst[1]]; | |
119 | } else { | |
120 | NSArray * el = (NSArray *) eval_ast(ast, env); | |
121 | NSArray * args = @[]; | |
122 | if ([el count] > 1) { | |
123 | args = _rest(el); | |
124 | } | |
125 | if ([el[0] isKindOfClass:[MalFunc class]]) { | |
126 | MalFunc * mf = el[0]; | |
127 | env = [Env fromBindings:[mf env] binds:[mf params] exprs:args]; | |
128 | ast = [mf ast]; // TCO | |
129 | } else { | |
130 | NSObject * (^ f)(NSArray *) = el[0]; | |
131 | return f(args); | |
132 | } | |
133 | } | |
134 | } | |
135 | } | |
136 | ||
137 | ||
138 | NSString *PRINT(NSObject *exp) { | |
139 | return _pr_str(exp, true); | |
140 | } | |
141 | ||
142 | // REPL | |
143 | NSString *REP(NSString *line, Env *env) { | |
144 | return PRINT(EVAL(READ(line), env)); | |
145 | } | |
146 | ||
147 | int main () { | |
148 | // Outside of pool to prevent "Block_release called upon | |
149 | // a stack..." message on exit | |
150 | Env * repl_env = [[Env alloc] init]; | |
151 | NSArray *args = [[NSProcessInfo processInfo] arguments]; | |
152 | ||
153 | // Create an autorelease pool to manage the memory into the program | |
154 | NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init]; | |
155 | // If using automatic reference counting (ARC), use @autoreleasepool instead: | |
156 | // @autoreleasepool { | |
157 | ||
158 | // core.m: defined using Objective-C | |
159 | NSDictionary * core_ns = [Core ns]; | |
160 | for (NSString* key in core_ns) { | |
161 | [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]]; | |
162 | } | |
163 | [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) { | |
164 | return EVAL(args[0], repl_env); | |
165 | }]; | |
166 | NSArray *argv = @[]; | |
167 | if ([args count] > 2) { | |
168 | argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)]; | |
169 | } | |
170 | [repl_env set:(MalSymbol *)@"*ARGV*" val:argv]; | |
171 | ||
172 | // core.mal: defined using the language itself | |
173 | REP(@"(def! not (fn* (a) (if a false true)))", repl_env); | |
e6d41de4 | 174 | REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env); |
7cae6e6f JM |
175 | |
176 | if ([args count] > 1) { | |
177 | @try { | |
178 | REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env); | |
179 | } @catch(NSString *e) { | |
180 | printf("Error: %s\n", [e UTF8String]); | |
181 | } | |
182 | return 0; | |
183 | } | |
184 | ||
185 | while (true) { | |
186 | char *rawline = _readline("user> "); | |
187 | if (!rawline) { break; } | |
188 | NSString *line = [NSString stringWithUTF8String:rawline]; | |
189 | if ([line length] == 0) { continue; } | |
190 | @try { | |
191 | printf("%s\n", [[REP(line, repl_env) description] UTF8String]); | |
192 | } @catch(NSString *e) { | |
193 | printf("Error: %s\n", [e UTF8String]); | |
dd7a4f55 JM |
194 | } @catch(NSObject *e) { |
195 | NSObject * exc = e; | |
196 | printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]); | |
7cae6e6f JM |
197 | } @catch(NSException *e) { |
198 | if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; } | |
199 | printf("Exception: %s\n", [[e reason] UTF8String]); | |
200 | } | |
201 | } | |
202 | ||
203 | [pool drain]; | |
204 | ||
205 | // } | |
206 | } |