[jackhill/mal.git] / objc / step8_macros.m

#import <Foundation/Foundation.h>

#import "mal_readline.h"
#import "types.h"
#import "reader.h"
#import "printer.h"
#import "env.h"
#import "malfunc.h"
#import "core.h"

// read
NSObject *READ(NSString *str) {
    return read_str(str);
}

// eval
BOOL is_pair(NSObject *obj) {
    return [obj isKindOfClass:[NSArray class]] &&
           [(NSArray *)obj count] > 0;
}

NSObject * quasiquote(NSObject *ast) {
    if (!is_pair(ast)) {
        return @[[MalSymbol stringWithString:@"quote"], ast];
    } else {
        NSArray * alst = (NSArray *)ast;
        id a0 = alst[0];
        if ([a0 isKindOfClass:[MalSymbol class]] &&
            [(NSString *)a0 isEqualTo:@"unquote"]) {
            return alst[1];
        } else if (is_pair(a0)) {
            id a0lst = (NSArray *)a0;
            id a00 = a0lst[0];
            if ([a00 isKindOfClass:[MalSymbol class]] &&
                [(NSString *)a00 isEqualTo:@"splice-unquote"]) {
                return @[[MalSymbol stringWithString:@"concat"],
                         a0lst[1],
                         quasiquote(_rest(alst))];
            }
        }
        return @[[MalSymbol stringWithString:@"cons"],
                 quasiquote(a0),
                 quasiquote(_rest(alst))];
    }
}

BOOL is_macro_call(NSObject *ast, Env *env) {
    if (list_Q(ast)) {
        NSArray * alst = (NSArray *)ast;
        if ([alst[0] isKindOfClass:[MalSymbol class]] && [env find:alst[0]]) {
            id mf = [env get:alst[0]];
            if ([mf isKindOfClass:[MalFunc class]]) {
                return [(MalFunc *)mf isMacro];
            }
        }
    }
    return false;
}

NSObject *macroexpand(NSObject *ast, Env *env) {
    while(is_macro_call(ast, env)) {
        NSArray * alst = (NSArray *)ast;
        MalFunc * mf = (MalFunc *)[env get:alst[0]];
        ast = [mf apply:_rest(alst)];
    }
    return ast;
}

NSObject *eval_ast(NSObject *ast, Env *env) {
    if ([ast isMemberOfClass:[MalSymbol class]]) {
        return [env get:(MalSymbol *)ast];
    } else if ([ast isKindOfClass:[NSArray class]]) {
        NSMutableArray *newLst = [NSMutableArray array];
        for (NSObject * x in (NSArray *)ast) {
            [newLst addObject:EVAL(x, env)];
        }
        if ([ast isKindOfClass:[MalVector class]]) {
            return [MalVector fromArray:newLst];
        } else {
            return newLst;
        }
    } else if ([ast isKindOfClass:[NSDictionary class]]) {
        NSMutableDictionary *newDict = [NSMutableDictionary dictionary];
        for (NSString * k in (NSDictionary *)ast) {
            newDict[k] = EVAL(((NSDictionary *)ast)[k], env);
        }
        return newDict;
    } else {
        return ast;
    }
}

NSObject *EVAL(NSObject *ast, Env *env) {
  while (true) {
    //NSLog(@"EVAL: %@ (%@)", _pr_str(ast, true), env);
    if (!list_Q(ast)) {
        return eval_ast(ast, env);
    }

    // apply list
    if ([(NSArray *)ast count] == 0) {
        return ast;
    }
    ast = macroexpand(ast, env);
    if (!list_Q(ast)) {
        return eval_ast(ast, env);
    }

    NSArray * alst = (NSArray *)ast;
    id a0 = alst[0];
    NSString * a0sym = [a0 isKindOfClass:[MalSymbol class]] ? (NSString *)a0
                                                            : @"__<*fn*>__";

    if ([a0sym isEqualTo:@"def!"]) {
        return [env set:((MalSymbol *)alst[1]) val:EVAL(alst[2], env)];
    } else if ([(NSString *)a0 isEqualTo:@"let*"]) {
        Env *let_env = [Env fromOuter:env];
        NSArray * binds = (NSArray *)alst[1];
        for (int i=0; i < [binds count]; i+=2) {
            [let_env set:binds[i] val:EVAL(binds[i+1], let_env)];
        }
        env = let_env;
        ast = alst[2]; // TCO
    } else if ([(NSString *)a0 isEqualTo:@"quote"]) {
        return alst[1];
    } else if ([(NSString *)a0 isEqualTo:@"quasiquote"]) {
        ast = quasiquote(alst[1]); // TCO
    } else if ([a0sym isEqualTo:@"defmacro!"]) {
        MalFunc * f = (MalFunc *)EVAL(alst[2], env);
        f.isMacro = true;
        return [env set:alst[1] val:f];
    } else if ([a0sym isEqualTo:@"macroexpand"]) {
        return macroexpand(alst[1], env);
    } else if ([a0sym isEqualTo:@"do"]) {
        NSRange r = NSMakeRange(1, [alst count] - 2);
        eval_ast([alst subarrayWithRange:r], env);
        ast = [alst lastObject]; // TCO
    } else if ([a0sym isEqualTo:@"if"]) {
        NSObject * cond = EVAL(alst[1], env);
        if ([cond isKindOfClass:[NSNull class]] ||
            [cond isKindOfClass:[MalFalse class]]) {
            if ([alst count] > 3) {
                ast = alst[3]; // TCO
            } else {
                return [NSNull alloc];
            }
        } else {
            ast = alst[2]; // TCO
        }
    } else if ([a0sym isEqualTo:@"fn*"]) {
        return [[MalFunc alloc] init:alst[2] env:env params:alst[1]];
    } else {
        NSArray * el = (NSArray *) eval_ast(ast, env);
        NSArray * args = @[];
        if ([el count] > 1) {
            args = _rest(el);
        }
        if ([el[0] isKindOfClass:[MalFunc class]]) {
            MalFunc * mf = el[0];
            env = [Env fromBindings:[mf env] binds:[mf params] exprs:args];
            ast = [mf ast]; // TCO
        } else {
            NSObject * (^ f)(NSArray *) = el[0];
            return f(args);
        }
    }
  }
}

// print
NSString *PRINT(NSObject *exp) {
    return _pr_str(exp, true);
}

// REPL
NSString *REP(NSString *line, Env *env) {
    return PRINT(EVAL(READ(line), env));
}

int main () {
    // Outside of pool to prevent "Block_release called upon
    // a stack..." message on exit
    Env * repl_env = [[Env alloc] init];
    NSArray *args = [[NSProcessInfo processInfo] arguments];

    // Create an autorelease pool to manage the memory into the program
    NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
    // If using automatic reference counting (ARC), use @autoreleasepool instead:
//    @autoreleasepool {

    // core.m: defined using Objective-C
    NSDictionary * core_ns = [Core ns];
    for (NSString* key in core_ns) {
        [repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]];
    }
    [repl_env set:(MalSymbol *)@"eval" val:^(NSArray *args) {
        return EVAL(args[0], repl_env);
    }];
    NSArray *argv = @[];
    if ([args count] > 2) {
        argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)];
    }
    [repl_env set:(MalSymbol *)@"*ARGV*" val:argv];

    // core.mal: defined using the language itself
    REP(@"(def! not (fn* (a) (if a false true)))", repl_env);
    REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env);
    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);


    if ([args count] > 1) {
        @try {
            REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env);
        } @catch(NSString *e) {
            printf("Error: %s\n", [e UTF8String]);
        }
        return 0;
    }

    while (true) {
        char *rawline = _readline("user> ");
        if (!rawline) { break; }
        NSString *line = [NSString stringWithUTF8String:rawline];
        if ([line length] == 0) { continue; }
        @try {
            printf("%s\n", [[REP(line, repl_env) description] UTF8String]);
        } @catch(NSString *e) {
            printf("Error: %s\n", [e UTF8String]);
        } @catch(NSObject *e) {
            NSObject * exc = e;
            printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]);
        } @catch(NSException *e) {
            if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; }
            printf("Exception: %s\n", [[e reason] UTF8String]);
        }
    }

    [pool drain];

//    }
}
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	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
203e9599 JM	101	if ([(NSArray *)ast count] == 0) {
	102	return ast;
	103	}
7cae6e6f JM	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:@"do"]) {
	135	NSRange r = NSMakeRange(1, [alst count] - 2);
	136	eval_ast([alst subarrayWithRange:r], env);
	137	ast = [alst lastObject]; // TCO
	138	} else if ([a0sym isEqualTo:@"if"]) {
	139	NSObject * cond = EVAL(alst[1], env);
	140	if ([cond isKindOfClass:[NSNull class]] \|\|
	141	[cond isKindOfClass:[MalFalse class]]) {
	142	if ([alst count] > 3) {
	143	ast = alst[3]; // TCO
	144	} else {
	145	return [NSNull alloc];
	146	}
	147	} else {
	148	ast = alst[2]; // TCO
	149	}
	150	} else if ([a0sym isEqualTo:@"fn*"]) {
	151	return [[MalFunc alloc] init:alst[2] env:env params:alst[1]];
	152	} else {
	153	NSArray * el = (NSArray *) eval_ast(ast, env);
	154	NSArray * args = @[];
	155	if ([el count] > 1) {
	156	args = _rest(el);
	157	}
	158	if ([el[0] isKindOfClass:[MalFunc class]]) {
	159	MalFunc * mf = el[0];
	160	env = [Env fromBindings:[mf env] binds:[mf params] exprs:args];
	161	ast = [mf ast]; // TCO
	162	} else {
	163	NSObject * (^ f)(NSArray *) = el[0];
	164	return f(args);
	165	}
	166	}
	167	}
168	}
169
170	// print
171	NSString PRINT(NSObject exp) {
172	return _pr_str(exp, true);
173	}
174
175	// REPL
176	NSString REP(NSString line, Env *env) {
177	return PRINT(EVAL(READ(line), env));
178	}
179
180	int main () {
181	// Outside of pool to prevent "Block_release called upon
182	// a stack..." message on exit
183	Env * repl_env = [[Env alloc] init];
184	NSArray *args = [[NSProcessInfo processInfo] arguments];
185
186	// Create an autorelease pool to manage the memory into the program
187	NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
188	// If using automatic reference counting (ARC), use @autoreleasepool instead:
189	// @autoreleasepool {
190
191	// core.m: defined using Objective-C
192	NSDictionary * core_ns = [Core ns];
193	for (NSString* key in core_ns) {
194	[repl_env set:(MalSymbol *)key val:[core_ns objectForKey:key]];
195	}
196	[repl_env set:(MalSymbol )@"eval" val:^(NSArray args) {
197	return EVAL(args[0], repl_env);
198	}];
199	NSArray *argv = @[];
200	if ([args count] > 2) {
201	argv = [args subarrayWithRange:NSMakeRange(2, [args count] - 2)];
202	}
203	[repl_env set:(MalSymbol )@"ARGV*" val:argv];
204
205	// core.mal: defined using the language itself
206	REP(@"(def! not (fn* (a) (if a false true)))", repl_env);
e6d41de4	207	REP(@"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env);
7cae6e6f	208	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);
7cae6e6f JM	209
	210
	211	if ([args count] > 1) {
	212	@try {
	213	REP([NSString stringWithFormat:@"(load-file \"%@\")", args[1]], repl_env);
	214	} @catch(NSString *e) {
	215	printf("Error: %s\n", [e UTF8String]);
	216	}
	217	return 0;
	218	}
	219
	220	while (true) {
	221	char *rawline = _readline("user> ");
	222	if (!rawline) { break; }
	223	NSString *line = [NSString stringWithUTF8String:rawline];
	224	if ([line length] == 0) { continue; }
	225	@try {
	226	printf("%s\n", [[REP(line, repl_env) description] UTF8String]);
	227	} @catch(NSString *e) {
	228	printf("Error: %s\n", [e UTF8String]);
dd7a4f55 JM	229	} @catch(NSObject *e) {
	230	NSObject * exc = e;
	231	printf("Exception: %s\n", [_pr_str(exc, true) UTF8String]);
7cae6e6f JM	232	} @catch(NSException *e) {
	233	if ([[e name] isEqualTo:@"ReaderContinue"]) { continue; }
	234	printf("Exception: %s\n", [[e reason] UTF8String]);
	235	}
	236	}
	237
	238	[pool drain];
	239
	240	// }
	241	}