objc/stepA_mal.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     ast = macroexpand(ast, env);
 102     if (!list_Q(ast)) {
 103         return eval_ast(ast, env);
 104     }
 105
 106     NSArray * alst = (NSArray *)ast;
 107     id a0 = alst[0];
 108     NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0
 109                                                             : @"__<*fn*>__";
 110
 111     if ([a0sym isEqualTo:@"def!"]) {
 112         return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)];
 113     } else if ([(NSString *)a0 isEqualTo:@"let*"]) {
 114         Env *let_env = [Env fromOuter:env];
 115         NSArray * binds = (NSArray *)alst[1];
 116         for (int i=0; i < [binds count]; i+=2) {
 117             [let_env set:binds[i] val:EVAL(binds[i+1], let_env)];
 118         }
 119         env = let_env;
 120         ast = alst[2]; // TCO
 121     } else if ([(NSString *)a0 isEqualTo:@"quote"]) {
 122         return alst[1];
 123     } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) {
 124         ast = quasiquote(alst[1]); // TCO
 125     } else if ([a0sym isEqualTo:@"defmacro!"]) {
 126         MalFunc * f = (MalFunc *)EVAL(alst[2], env);
 127         f.isMacro = true;
 128         return [env set:alst[1] val:f];
 129     } else if ([a0sym isEqualTo:@"macroexpand"]) {
 130         return macroexpand(alst[1], env);
 131     } else if ([a0sym isEqualTo:@"try*"]) {
 132         @try {
 133             return EVAL(alst[1], env);
 134         } @catch(NSObject *e) {
 135             if ([alst count] > 2 && [alst[2] isKindOfClass:[NSArray class]]) {
 136                 NSArray * a2lst = alst[2];
 137                 if ([a2lst[0] isKindOfClass:[MalSymbol class]] &&
 138                     [(MalSymbol *)a2lst[0] isEqualTo:@"catch*"]) {
 139                     NSObject * exc = e;
 140                     if ([e isKindOfClass:[NSException class]]) {
 141                         exc = [e description];
 142                     }
 143                     return EVAL(a2lst[2], [Env fromBindings:env
 144                                                binds:@[a2lst[1]]
 145                                                exprs:@[exc]]);
 146                 }
 147             }
 148             @throw e;
 149         }
 150     } else if ([a0sym isEqualTo:@"do"]) {
 151         NSRange r = NSMakeRange(1, [alst count] - 2);
 152         eval_ast([alst subarrayWithRange:r], env);
 153         ast = [alst lastObject]; // TCO
 154     } else if ([a0sym isEqualTo:@"if"]) {
 155         NSObject * cond = EVAL(alst[1], env);
 156         if ([cond isKindOfClass:[NSNull class]] ||
 157             [cond isKindOfClass:[MalFalse class]]) {
 158             if ([alst count] > 3) {
 159                 ast = alst[3]; // TCO
 160             } else {
 161                 return [NSNull alloc];
 162             }
 163         } else {
 164             ast = alst[2]; // TCO
 165         }
 166     } else if ([a0sym isEqualTo:@"fn*"]) {
 167         return [[MalFunc alloc] init:alst[2] env:env params:alst[1]];
 168     } else {
 169         NSArray * el = (NSArray *) eval_ast(ast, env);
 170         NSArray * args = @[];
 171         if ([el count] > 1) {
 172             args = _rest(el);
 173         }
 174         if ([el[0] isKindOfClass:[MalFunc class]]) {
 175             MalFunc * mf = el[0];
 176             env = [Env fromBindings:[mf env] binds:[mf params] exprs:args];
 177             ast = [mf ast]; // TCO
 178         } else {
 179             NSObject * (^ f)(NSArray *) = el[0];
 180             return f(args);
 181         }
 182     }
 183   }
 184 }
 185
 186 // print
 187 NSString *PRINT(NSObject *exp) {
 188     return _pr_str(exp, true);
 189 }
 190
 191 // REPL
 192 NSString *REP(NSString *line, Env *env) {
 193     return PRINT(EVAL(READ(line), env));
 194 }
 195
 196 int main () {
 197     // Outside of pool to prevent "Block_release called upon
 198     // a stack..." message on exit
 199     Env * repl_env = [[Env alloc] init];
 200     NSArray *args = [[NSProcessInfo processInfo] arguments];
 201
 202     // Create an autorelease pool to manage the memory into the program
 203     NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
 204     // If using automatic reference counting (ARC), use @autoreleasepool instead:
 205 //    @autoreleasepool {
 206
 207     // core.m: defined using Objective-C
 208     NSDictionary * core_ns = [Core ns];
 209     for (NSString* key in core_ns) {
 210         [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]];
 211     }
 212     [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) {
 213         return EVAL(args[0], repl_env);
 214     }];
 215     NSArray *argv = @[];
 216     if ([args count] > 2) {
 217         argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)];
 218     }
 219     [repl_env set:(MalSymbol *)@"*ARGV*" val:argv];
 220
 221     // core.mal: defined using the language itself
 222     REP(@"(def! *host-language* \"Objective-C\")", repl_env);
 223     REP(@"(def! not (fn* (a) (if a false true)))", repl_env);
 224     REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env);
 225     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);
 226     REP(@"(def! *gensym-counter* (atom 0))", repl_env);
 227     REP(@"(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env);
 228     REP(@"(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))", repl_env);
 229
 230
 231     if ([args count] > 1) {
 232         @try {
 233             REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env);
 234         } @catch(NSString *e) {
 235             printf("Error: %s\n", [e UTF8String]);
 236         }
 237         return 0;
 238     }
 239
 240     while (true) {
 241         char *rawline = _readline("user> ");
 242         if (!rawline) { break; }
 243         NSString *line = [NSString stringWithUTF8String:rawline];
 244         if ([line length] == 0) { continue; }
 245         @try {
 246             printf("%s\n", [[REP(line, repl_env) description] UTF8String]);
 247         } @catch(NSString *e) {
 248             printf("Error: %s\n", [e UTF8String]);
 249         } @catch(NSException *e) {
 250             if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; }
 251             printf("Exception: %s\n", [[e reason] UTF8String]);
 252         }
 253     }
 254
 255     [pool drain];
 256
 257 //    }
 258 }