impls/objc/step9_try.m

   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 BOOL is_macro_call(NSObject *ast, Env *env) {
  48     if (list_Q(ast)) {
  49         NSArray * alst = (NSArray *)ast;
  50         if ([alst[0] isKindOfClass:[MalSymbol class]] && [env find:alst[0]]) {
  51             id mf = [env get:alst[0]];
  52             if ([mf isKindOfClass:[MalFunc class]]) {
  53                 return [(MalFunc *)mf isMacro];
  54             }
  55         }
  56     }
  57     return false;
  58 }
  59
  60 NSObject *macroexpand(NSObject *ast, Env *env) {
  61     while(is_macro_call(ast, env)) {
  62         NSArray * alst = (NSArray *)ast;
  63         MalFunc * mf = (MalFunc *)[env get:alst[0]];
  64         ast = [mf apply:_rest(alst)];
  65     }
  66     return ast;
  67 }
  68
  69 NSObject *eval_ast(NSObject *ast, Env *env) {
  70     if ([ast isMemberOfClass:[MalSymbol class]]) {
  71         return [env get:(MalSymbol *)ast];
  72     } else if ([ast isKindOfClass:[NSArray class]]) {
  73         NSMutableArray *newLst = [NSMutableArray array];
  74         for (NSObject * x in (NSArray *)ast) {
  75             [newLst addObject:EVAL(x, env)];
  76         }
  77         if ([ast isKindOfClass:[MalVector class]]) {
  78             return [MalVector fromArray:newLst];
  79         } else {
  80             return newLst;
  81         }
  82     } else if ([ast isKindOfClass:[NSDictionary class]]) {
  83         NSMutableDictionary *newDict = [NSMutableDictionary dictionary];
  84         for (NSString * k in (NSDictionary *)ast) {
  85             newDict[k] = EVAL(((NSDictionary *)ast)[k], env);
  86         }
  87         return newDict;
  88     } else {
  89         return ast;
  90     }
  91 }
  92
  93 NSObject *EVAL(NSObject *ast, Env *env) {
  94   while (true) {
  95     //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env);
  96     if (!list_Q(ast)) {
  97         return eval_ast(ast, env);
  98     }
  99
 100     // apply list
 101     if ([(NSArray *)ast count] == 0) {
 102         return ast;
 103     }
 104     ast = macroexpand(ast, env);
 105     if (!list_Q(ast)) {
 106         return eval_ast(ast, env);
 107     }
 108
 109     NSArray * alst = (NSArray *)ast;
 110     id a0 = alst[0];
 111     NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0
 112                                                             : @"__<*fn*>__";
 113
 114     if ([a0sym isEqualTo:@"def!"]) {
 115         return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)];
 116     } else if ([(NSString *)a0 isEqualTo:@"let*"]) {
 117         Env *let_env = [Env fromOuter:env];
 118         NSArray * binds = (NSArray *)alst[1];
 119         for (int i=0; i < [binds count]; i+=2) {
 120             [let_env set:binds[i] val:EVAL(binds[i+1], let_env)];
 121         }
 122         env = let_env;
 123         ast = alst[2]; // TCO
 124     } else if ([(NSString *)a0 isEqualTo:@"quote"]) {
 125         return alst[1];
 126     } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) {
 127         ast = quasiquote(alst[1]); // TCO
 128     } else if ([a0sym isEqualTo:@"defmacro!"]) {
 129         MalFunc * f = (MalFunc *)EVAL(alst[2], env);
 130         f.isMacro = true;
 131         return [env set:alst[1] val:f];
 132     } else if ([a0sym isEqualTo:@"macroexpand"]) {
 133         return macroexpand(alst[1], env);
 134     } else if ([a0sym isEqualTo:@"try*"]) {
 135         @try {
 136             return EVAL(alst[1], env);
 137         } @catch(NSObject *e) {
 138             if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) {
 139                 NSArray * a2lst = alst[2];
 140                 if ([a2lst[0] isKindOfClass:[MalSymbol class]] &&
 141                     [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) {
 142                     NSObject * exc = e;
 143                     if ([e isKindOfClass:[NSException class]]) {
 144                         exc = [e description];
 145                     }
 146                     return EVAL(a2lst[2], [Env fromBindings:env
 147                                                binds:@[a2lst[1]]
 148                                                exprs:@[exc]]);
 149                 }
 150             }
 151             @throw e;
 152         }
 153     } else if ([a0sym isEqualTo:@"do"]) {
 154         NSRange r = NSMakeRange(1, [alst count] - 2);
 155         eval_ast([alst subarrayWithRange:r], env);
 156         ast = [alst lastObject]; // TCO
 157     } else if ([a0sym isEqualTo:@"if"]) {
 158         NSObject * cond = EVAL(alst[1], env);
 159         if ([cond isKindOfClass:[NSNull class]] ||
 160             [cond isKindOfClass:[MalFalse class]]) {
 161             if ([alst count] > 3) {
 162                 ast = alst[3]; // TCO
 163             } else {
 164                 return [NSNull alloc];
 165             }
 166         } else {
 167             ast = alst[2]; // TCO
 168         }
 169     } else if ([a0sym isEqualTo:@"fn*"]) {
 170         return [[MalFunc alloc] init:alst[2] env:env params:alst[1]];
 171     } else {
 172         NSArray * el = (NSArray *) eval_ast(ast, env);
 173         NSArray * args = @[];
 174         if ([el count] > 1) {
 175             args = _rest(el);
 176         }
 177         if ([el[0] isKindOfClass:[MalFunc class]]) {
 178             MalFunc * mf = el[0];
 179             env = [Env fromBindings:[mf env] binds:[mf params] exprs:args];
 180             ast = [mf ast]; // TCO
 181         } else {
 182             NSObject * (^ f)(NSArray *) = el[0];
 183             return f(args);
 184         }
 185     }
 186   }
 187 }
 188
 189 // print
 190 NSString *PRINT(NSObject *exp) {
 191     return _pr_str(exp, true);
 192 }
 193
 194 // REPL
 195 NSString *REP(NSString *line, Env *env) {
 196     return PRINT(EVAL(READ(line), env));
 197 }
 198
 199 int main () {
 200     // Outside of pool to prevent "Block_release called upon
 201     // a stack..." message on exit
 202     Env * repl_env = [[Env alloc] init];
 203     NSArray *args = [[NSProcessInfo processInfo] arguments];
 204
 205     // Create an autorelease pool to manage the memory into the program
 206     NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
 207     // If using automatic reference counting (ARC), use @autoreleasepool instead:
 208 //    @autoreleasepool {
 209
 210     // core.m: defined using Objective-C
 211     NSDictionary * core_ns = [Core ns];
 212     for (NSString* key in core_ns) {
 213         [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]];
 214     }
 215     [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) {
 216         return EVAL(args[0], repl_env);
 217     }];
 218     NSArray *argv = @[];
 219     if ([args count] > 2) {
 220         argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)];
 221     }
 222     [repl_env set:(MalSymbol *)@"*ARGV*" val:argv];
 223
 224     // core.mal: defined using the language itself
 225     REP(@"(def! not (fn* (a) (if a false true)))", repl_env);
 226     REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env);
 227     REP(@"(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", repl_env);
 228
 229
 230     if ([args count] > 1) {
 231         @try {
 232             REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env);
 233         } @catch(NSString *e) {
 234             printf("Error: %s\n", [e UTF8String]);
 235         }
 236         return 0;
 237     }
 238
 239     while (true) {
 240         char *rawline = _readline("user> ");
 241         if (!rawline) { break; }
 242         NSString *line = [NSString stringWithUTF8String:rawline];
 243         if ([line length] == 0) { continue; }
 244         @try {
 245             printf("%s\n", [[REP(line, repl_env) description] UTF8String]);
 246         } @catch(NSString *e) {
 247             printf("Error: %s\n", [e UTF8String]);
 248         } @catch(NSObject *e) {
 249             NSObject * exc = e;
 250             printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]);
 251         } @catch(NSException *e) {
 252             if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; }
 253             printf("Exception: %s\n", [[e reason] UTF8String]);
 254         }
 255     }
 256
 257     [pool drain];
 258
 259 //    }
 260 }