[jackhill/mal.git] / c / step7_quote.c

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>

#include "types.h"
#include "readline.h"
#include "reader.h"
#include "core.h"

// Declarations
MalVal *EVAL(MalVal *ast, Env *env);

// read
MalVal *READ(char prompt[], char *str) {
    char *line;
    MalVal *ast;
    if (str) {
        line = str;
    } else {
        line = _readline(prompt);
        if (!line) {
            _error("EOF");
            return NULL;
        }
    }
    ast = read_str(line);
    if (!str) { free(line); }
    return ast;
}

// eval
int is_pair(MalVal *x) {
    return _sequential_Q(x) && (_count(x) > 0);
}

MalVal *quasiquote(MalVal *ast) {
    if (!is_pair(ast)) {
        return _listX(2, malval_new_symbol("quote"), ast);
    } else {
        MalVal *a0 = _nth(ast, 0);
        if ((a0->type & MAL_SYMBOL) &&
            strcmp("unquote", a0->val.string) == 0) {
            return _nth(ast, 1);
        } else if (is_pair(a0)) {
            MalVal *a00 = _nth(a0, 0);
            if ((a00->type & MAL_SYMBOL) &&
                strcmp("splice-unquote", a00->val.string) == 0) {
                return _listX(3, malval_new_symbol("concat"),
                                 _nth(a0, 1),
                                 quasiquote(_rest(ast)));
            }
        }
        return _listX(3, malval_new_symbol("cons"),
                         quasiquote(a0),
                         quasiquote(_rest(ast)));
    }
}

MalVal *eval_ast(MalVal *ast, Env *env) {
    if (!ast || mal_error) return NULL;
    if (ast->type == MAL_SYMBOL) {
        //g_print("EVAL symbol: %s\n", ast->val.string);
        return env_get(env, ast);
    } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) {
        //g_print("EVAL sequential: %s\n", _pr_str(ast,1));
        MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env);
        if (!el || mal_error) return NULL;
        el->type = ast->type;
        return el;
    } else if (ast->type == MAL_HASH_MAP) {
        //g_print("EVAL hash_map: %s\n", _pr_str(ast,1));
        GHashTableIter iter;
        gpointer key, value;
        MalVal *seq = malval_new_list(MAL_LIST,
                                    g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
                                                        _count(ast)));
        g_hash_table_iter_init (&iter, ast->val.hash_table);
        while (g_hash_table_iter_next (&iter, &key, &value)) {
            MalVal *kname = malval_new_string((char *)key);
            g_array_append_val(seq->val.array, kname);
            MalVal *new_val = EVAL((MalVal *)value, env);
            g_array_append_val(seq->val.array, new_val);
        }
        return _hash_map(seq);
    } else {
        //g_print("EVAL scalar: %s\n", _pr_str(ast,1));
        return ast;
    }
}

MalVal *EVAL(MalVal *ast, Env *env) {
    while (TRUE) {

    if (!ast || mal_error) return NULL;
    //g_print("EVAL: %s\n", _pr_str(ast,1));
    if (ast->type != MAL_LIST) {
        return eval_ast(ast, env);
    }
    if (!ast || mal_error) return NULL;

    // apply list
    //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
    int i, len;
    if (_count(ast) == 0) { return ast; }
    MalVal *a0 = _nth(ast, 0);
    if ((a0->type & MAL_SYMBOL) &&
        strcmp("def!", a0->val.string) == 0) {
        //g_print("eval apply def!\n");
        MalVal *a1 = _nth(ast, 1),
               *a2 = _nth(ast, 2);
        MalVal *res = EVAL(a2, env);
        if (mal_error) return NULL;
        env_set(env, a1, res);
        return res;
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("let*", a0->val.string) == 0) {
        //g_print("eval apply let*\n");
        MalVal *a1 = _nth(ast, 1),
               *a2 = _nth(ast, 2),
               *key, *val;
        assert_type(a1, MAL_LIST|MAL_VECTOR,
                    "let* bindings must be list or vector");
        len = _count(a1);
        assert((len % 2) == 0, "odd number of let* bindings forms");
        Env *let_env = new_env(env, NULL, NULL);
        for(i=0; i<len; i+=2) {
            key = g_array_index(a1->val.array, MalVal*, i);
            val = g_array_index(a1->val.array, MalVal*, i+1);
            assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
            env_set(let_env, key, EVAL(val, let_env));
        }
        ast = a2;
        env = let_env;
        // Continue loop
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("quote", a0->val.string) == 0) {
        //g_print("eval apply quote\n");
        return _nth(ast, 1);
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("quasiquote", a0->val.string) == 0) {
        //g_print("eval apply quasiquote\n");
        MalVal *a1 = _nth(ast, 1);
        ast = quasiquote(a1);
        // Continue loop
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("do", a0->val.string) == 0) {
        //g_print("eval apply do\n");
        eval_ast(_slice(ast, 1, _count(ast)-1), env);
        ast = _last(ast);
        // Continue loop
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("if", a0->val.string) == 0) {
        //g_print("eval apply if\n");
        MalVal *a1 = _nth(ast, 1);
        MalVal *cond = EVAL(a1, env);
        if (!cond || mal_error) return NULL;
        if (cond->type & (MAL_FALSE|MAL_NIL)) {
            // eval false slot form
            if (ast->val.array->len > 3) {
                ast = _nth(ast, 3);
            } else {
                return &mal_nil;
            }
        } else {
            // eval true slot form
            ast = _nth(ast, 2);
        }
        // Continue loop
    } else if ((a0->type & MAL_SYMBOL) &&
               strcmp("fn*", a0->val.string) == 0) {
        //g_print("eval apply fn*\n");
        MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
        mf->val.func.evaluator = EVAL;
        mf->val.func.args = _nth(ast, 1);
        mf->val.func.body = _nth(ast, 2);
        mf->val.func.env = env;
        return mf;
    } else {
        //g_print("eval apply\n");
        MalVal *el = eval_ast(ast, env);
        if (!el || mal_error) { return NULL; }
        MalVal *f = _first(el),
               *args = _rest(el);
        assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
                    "cannot apply '%s'", _pr_str(f,1));
        if (f->type & MAL_FUNCTION_MAL) {
            ast = f->val.func.body;
            env = new_env(f->val.func.env, f->val.func.args, args);
            // Continue loop
        } else {
            return _apply(f, args);
        }
    }

    } // TCO while loop
}

// print
char *PRINT(MalVal *exp) {
    if (mal_error) {
        fprintf(stderr, "Error: %s\n", mal_error->val.string);
        malval_free(mal_error);
        mal_error = NULL;
        return NULL;
    }
    return _pr_str(exp,1);
}

// repl

// read and eval
MalVal *RE(Env *env, char *prompt, char *str) {
    MalVal *ast, *exp;
    ast = READ(prompt, str);
    if (!ast || mal_error) return NULL;
    exp = EVAL(ast, env);
    if (ast != exp) {
        malval_free(ast);    // Free input structure
    }
    return exp;
}

// Setup the initial REPL environment
Env *repl_env;

MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); }

void init_repl_env(int argc, char *argv[]) {
    repl_env = new_env(NULL, NULL, NULL);

    // core.c: defined using C
    int i;
    for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
        env_set(repl_env,
                malval_new_symbol(core_ns[i].name),
                malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
    }
    env_set(repl_env,
            malval_new_symbol("eval"),
            malval_new_function((void*(*)(void *))do_eval, 1));

    MalVal *_argv = _listX(0);
    for (i=2; i < argc; i++) {
        MalVal *arg = malval_new_string(argv[i]);
        g_array_append_val(_argv->val.array, arg);
    }
    env_set(repl_env, malval_new_symbol("*ARGV*"), _argv);

    // core.mal: defined using the language itself
    RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
    RE(repl_env, "",
       "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
}

int main(int argc, char *argv[])
{
    MalVal *exp;
    char *output;
    char prompt[100];

    // Set the initial prompt and environment
    snprintf(prompt, sizeof(prompt), "user> ");
    init_repl_env(argc, argv);
 
    if (argc > 1) {
        char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
        RE(repl_env, "", cmd);
        return 0;
    }

    // repl loop
    for(;;) {
        exp = RE(repl_env, prompt, NULL);
        if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
            return 0;
        }
        output = PRINT(exp);

        if (output) { 
            g_print("%s\n", output);
            free(output);        // Free output string
        }

        //malval_free(exp);    // Free evaluated expression
    }
}
Commit	Line	Data
31690700 JM	1	#include <stdlib.h>
31690700 JM	2	#include <stdio.h>
b81b2a7e	3	#include <string.h>
31690700	4	#include <unistd.h>
8cb5cda4	5
31690700 JM	6	#include "types.h"
	7	#include "readline.h"
	8	#include "reader.h"
ea81a808	9	#include "core.h"
31690700 JM	10
	11	// Declarations
	12	MalVal EVAL(MalVal ast, Env *env);
	13
	14	// read
	15	MalVal READ(char prompt[], char str) {
	16	char *line;
	17	MalVal *ast;
	18	if (str) {
	19	line = str;
	20	} else {
	21	line = _readline(prompt);
	22	if (!line) {
	23	_error("EOF");
	24	return NULL;
	25	}
	26	}
	27	ast = read_str(line);
	28	if (!str) { free(line); }
	29	return ast;
	30	}
	31
	32	// eval
	33	int is_pair(MalVal *x) {
	34	return _sequential_Q(x) && (_count(x) > 0);
	35	}
	36
	37	MalVal quasiquote(MalVal ast) {
	38	if (!is_pair(ast)) {
ea81a808	39	return _listX(2, malval_new_symbol("quote"), ast);
31690700 JM	40	} else {
	41	MalVal *a0 = _nth(ast, 0);
	42	if ((a0->type & MAL_SYMBOL) &&
	43	strcmp("unquote", a0->val.string) == 0) {
	44	return _nth(ast, 1);
	45	} else if (is_pair(a0)) {
	46	MalVal *a00 = _nth(a0, 0);
	47	if ((a00->type & MAL_SYMBOL) &&
	48	strcmp("splice-unquote", a00->val.string) == 0) {
ea81a808 JM	49	return _listX(3, malval_new_symbol("concat"),
ea81a808 JM	50	_nth(a0, 1),
8cb5cda4	51	quasiquote(_rest(ast)));
31690700 JM	52	}
31690700 JM	53	}
ea81a808 JM	54	return _listX(3, malval_new_symbol("cons"),
ea81a808 JM	55	quasiquote(a0),
8cb5cda4	56	quasiquote(_rest(ast)));
31690700 JM	57	}
	58	}
	59
	60	MalVal eval_ast(MalVal ast, Env *env) {
	61	if (!ast \|\| mal_error) return NULL;
	62	if (ast->type == MAL_SYMBOL) {
	63	//g_print("EVAL symbol: %s\n", ast->val.string);
b8ee29b2	64	return env_get(env, ast);
31690700 JM	65	} else if ((ast->type == MAL_LIST) \|\| (ast->type == MAL_VECTOR)) {
	66	//g_print("EVAL sequential: %s\n", _pr_str(ast,1));
	67	MalVal el = _map2((MalVal ()(void, void*))EVAL, ast, env);
	68	if (!el \|\| mal_error) return NULL;
	69	el->type = ast->type;
	70	return el;
	71	} else if (ast->type == MAL_HASH_MAP) {
	72	//g_print("EVAL hash_map: %s\n", _pr_str(ast,1));
	73	GHashTableIter iter;
	74	gpointer key, value;
	75	MalVal *seq = malval_new_list(MAL_LIST,
	76	g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
	77	_count(ast)));
	78	g_hash_table_iter_init (&iter, ast->val.hash_table);
	79	while (g_hash_table_iter_next (&iter, &key, &value)) {
	80	MalVal kname = malval_new_string((char )key);
	81	g_array_append_val(seq->val.array, kname);
	82	MalVal new_val = EVAL((MalVal )value, env);
	83	g_array_append_val(seq->val.array, new_val);
	84	}
8cb5cda4	85	return _hash_map(seq);
31690700 JM	86	} else {
	87	//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
	88	return ast;
	89	}
	90	}
	91
	92	MalVal EVAL(MalVal ast, Env *env) {
	93	while (TRUE) {
31690700	94
8cb5cda4 JM	95	if (!ast \|\| mal_error) return NULL;
	96	//g_print("EVAL: %s\n", _pr_str(ast,1));
	97	if (ast->type != MAL_LIST) {
	98	return eval_ast(ast, env);
	99	}
	100	if (!ast \|\| mal_error) return NULL;
	101
	102	// apply list
	103	//g_print("EVAL apply list: %s\n", _pr_str(ast,1));
	104	int i, len;
	105	if (_count(ast) == 0) { return ast; }
	106	MalVal *a0 = _nth(ast, 0);
	107	if ((a0->type & MAL_SYMBOL) &&
	108	strcmp("def!", a0->val.string) == 0) {
	109	//g_print("eval apply def!\n");
	110	MalVal *a1 = _nth(ast, 1),
	111	*a2 = _nth(ast, 2);
	112	MalVal *res = EVAL(a2, env);
b8ee29b2 JM	113	if (mal_error) return NULL;
b8ee29b2 JM	114	env_set(env, a1, res);
8cb5cda4 JM	115	return res;
	116	} else if ((a0->type & MAL_SYMBOL) &&
	117	strcmp("let*", a0->val.string) == 0) {
	118	//g_print("eval apply let*\n");
	119	MalVal *a1 = _nth(ast, 1),
	120	*a2 = _nth(ast, 2),
	121	key, val;
	122	assert_type(a1, MAL_LIST\|MAL_VECTOR,
	123	"let* bindings must be list or vector");
	124	len = _count(a1);
	125	assert((len % 2) == 0, "odd number of let* bindings forms");
	126	Env *let_env = new_env(env, NULL, NULL);
	127	for(i=0; i<len; i+=2) {
	128	key = g_array_index(a1->val.array, MalVal*, i);
	129	val = g_array_index(a1->val.array, MalVal*, i+1);
	130	assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
b8ee29b2	131	env_set(let_env, key, EVAL(val, let_env));
8cb5cda4	132	}
6301e0b6 JM	133	ast = a2;
	134	env = let_env;
	135	// Continue loop
8cb5cda4 JM	136	} else if ((a0->type & MAL_SYMBOL) &&
	137	strcmp("quote", a0->val.string) == 0) {
	138	//g_print("eval apply quote\n");
	139	return _nth(ast, 1);
	140	} else if ((a0->type & MAL_SYMBOL) &&
	141	strcmp("quasiquote", a0->val.string) == 0) {
	142	//g_print("eval apply quasiquote\n");
	143	MalVal *a1 = _nth(ast, 1);
6301e0b6 JM	144	ast = quasiquote(a1);
6301e0b6 JM	145	// Continue loop
8cb5cda4 JM	146	} else if ((a0->type & MAL_SYMBOL) &&
	147	strcmp("do", a0->val.string) == 0) {
	148	//g_print("eval apply do\n");
	149	eval_ast(_slice(ast, 1, _count(ast)-1), env);
	150	ast = _last(ast);
	151	// Continue loop
	152	} else if ((a0->type & MAL_SYMBOL) &&
	153	strcmp("if", a0->val.string) == 0) {
	154	//g_print("eval apply if\n");
	155	MalVal *a1 = _nth(ast, 1);
	156	MalVal *cond = EVAL(a1, env);
	157	if (!cond \|\| mal_error) return NULL;
	158	if (cond->type & (MAL_FALSE\|MAL_NIL)) {
	159	// eval false slot form
b8ee29b2 JM	160	if (ast->val.array->len > 3) {
	161	ast = _nth(ast, 3);
	162	} else {
8cb5cda4	163	return &mal_nil;
31690700	164	}
8cb5cda4 JM	165	} else {
	166	// eval true slot form
	167	ast = _nth(ast, 2);
	168	}
	169	// Continue loop
	170	} else if ((a0->type & MAL_SYMBOL) &&
	171	strcmp("fn*", a0->val.string) == 0) {
	172	//g_print("eval apply fn*\n");
	173	MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
	174	mf->val.func.evaluator = EVAL;
	175	mf->val.func.args = _nth(ast, 1);
	176	mf->val.func.body = _nth(ast, 2);
	177	mf->val.func.env = env;
	178	return mf;
	179	} else {
	180	//g_print("eval apply\n");
	181	MalVal *el = eval_ast(ast, env);
	182	if (!el \|\| mal_error) { return NULL; }
	183	MalVal *f = _first(el),
	184	*args = _rest(el);
	185	assert_type(f, MAL_FUNCTION_C\|MAL_FUNCTION_MAL,
	186	"cannot apply '%s'", _pr_str(f,1));
	187	if (f->type & MAL_FUNCTION_MAL) {
	188	ast = f->val.func.body;
	189	env = new_env(f->val.func.env, f->val.func.args, args);
31690700	190	// Continue loop
31690700	191	} else {
8cb5cda4	192	return _apply(f, args);
31690700 JM	193	}
31690700 JM	194	}
8cb5cda4 JM	195
8cb5cda4 JM	196	} // TCO while loop
31690700 JM	197	}
	198
	199	// print
	200	char PRINT(MalVal exp) {
	201	if (mal_error) {
	202	fprintf(stderr, "Error: %s\n", mal_error->val.string);
	203	malval_free(mal_error);
	204	mal_error = NULL;
	205	return NULL;
	206	}
	207	return _pr_str(exp,1);
	208	}
	209
	210	// repl
	211
	212	// read and eval
	213	MalVal RE(Env env, char prompt, char str) {
	214	MalVal ast, exp;
	215	ast = READ(prompt, str);
	216	if (!ast \|\| mal_error) return NULL;
	217	exp = EVAL(ast, env);
	218	if (ast != exp) {
	219	malval_free(ast); // Free input structure
	220	}
	221	return exp;
	222	}
	223
	224	// Setup the initial REPL environment
	225	Env *repl_env;
	226
b81b2a7e LB	227	MalVal do_eval(MalVal ast) { return EVAL(ast, repl_env); }
b81b2a7e LB	228
86b689f3	229	void init_repl_env(int argc, char *argv[]) {
31690700 JM	230	repl_env = new_env(NULL, NULL, NULL);
31690700 JM	231
8cb5cda4	232	// core.c: defined using C
31690700	233	int i;
86b689f3	234	for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
b8ee29b2 JM	235	env_set(repl_env,
b8ee29b2 JM	236	malval_new_symbol(core_ns[i].name),
8cb5cda4	237	malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
31690700	238	}
b8ee29b2 JM	239	env_set(repl_env,
b8ee29b2 JM	240	malval_new_symbol("eval"),
8cb5cda4	241	malval_new_function((void()(void *))do_eval, 1));
31690700	242
86b689f3 JM	243	MalVal *_argv = _listX(0);
	244	for (i=2; i < argc; i++) {
	245	MalVal *arg = malval_new_string(argv[i]);
	246	g_array_append_val(_argv->val.array, arg);
	247	}
b8ee29b2	248	env_set(repl_env, malval_new_symbol("ARGV"), _argv);
86b689f3	249
8cb5cda4	250	// core.mal: defined using the language itself
31690700 JM	251	RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
31690700 JM	252	RE(repl_env, "",
1617910a	253	"(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
31690700 JM	254	}
	255
	256	int main(int argc, char *argv[])
	257	{
	258	MalVal *exp;
	259	char *output;
	260	char prompt[100];
	261
	262	// Set the initial prompt and environment
	263	snprintf(prompt, sizeof(prompt), "user> ");
86b689f3	264	init_repl_env(argc, argv);
31690700 JM	265
	266	if (argc > 1) {
	267	char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
	268	RE(repl_env, "", cmd);
8cb5cda4 JM	269	return 0;
8cb5cda4 JM	270	}
31690700	271
86b689f3	272	// repl loop
8cb5cda4 JM	273	for(;;) {
	274	exp = RE(repl_env, prompt, NULL);
	275	if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
	276	return 0;
	277	}
	278	output = PRINT(exp);
31690700	279
8cb5cda4 JM	280	if (output) {
	281	g_print("%s\n", output);
	282	free(output); // Free output string
31690700	283	}
8cb5cda4 JM	284
8cb5cda4 JM	285	//malval_free(exp); // Free evaluated expression
31690700 JM	286	}
31690700 JM	287	}