DISABLE FDs (REMOVE ME).
[jackhill/mal.git] / objc / step7_quote.m
CommitLineData
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
12NSObject *READ(NSString *str) {
13 return read_str(str);
14}
15
16// eval
17BOOL is_pair(NSObject *obj) {
18 return [obj isKindOfClass:[NSArray class]] &&
19 [(NSArray *)obj count] > 0;
20}
21
22NSObject * 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
47NSObject *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
71NSObject *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// print
138NSString *PRINT(NSObject *exp) {
139 return _pr_str(exp, true);
140}
141
142// REPL
143NSString *REP(NSString *line, Env *env) {
144 return PRINT(EVAL(READ(line), env));
145}
146
147int 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}