[jackhill/mal.git] / impls / cpp / step9_try.cpp

#include "MAL.h"

#include "Environment.h"
#include "ReadLine.h"
#include "Types.h"

#include <iostream>
#include <memory>

malValuePtr READ(const String& input);
String PRINT(malValuePtr ast);
static void installFunctions(malEnvPtr env);
//  Installs functions and macros implemented in MAL.

static void makeArgv(malEnvPtr env, int argc, char* argv[]);
static String safeRep(const String& input, malEnvPtr env);
static malValuePtr quasiquote(malValuePtr obj);
static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env);

static ReadLine s_readLine("~/.mal-history");

static malEnvPtr replEnv(new malEnv);

int main(int argc, char* argv[])
{
    String prompt = "user> ";
    String input;
    installCore(replEnv);
    installFunctions(replEnv);
    makeArgv(replEnv, argc - 2, argv + 2);
    if (argc > 1) {
        String filename = escape(argv[1]);
        safeRep(STRF("(load-file %s)", filename.c_str()), replEnv);
        return 0;
    }
    while (s_readLine.get(prompt, input)) {
        String out = safeRep(input, replEnv);
        if (out.length() > 0)
            std::cout << out << "\n";
    }
    return 0;
}

static String safeRep(const String& input, malEnvPtr env)
{
    try {
        return rep(input, env);
    }
    catch (malEmptyInputException&) {
        return String();
    }
    catch (malValuePtr& mv) {
        return "Error: " + mv->print(true);
    }
    catch (String& s) {
        return "Error: " + s;
    };
}

static void makeArgv(malEnvPtr env, int argc, char* argv[])
{
    malValueVec* args = new malValueVec();
    for (int i = 0; i < argc; i++) {
        args->push_back(mal::string(argv[i]));
    }
    env->set("*ARGV*", mal::list(args));
}

String rep(const String& input, malEnvPtr env)
{
    return PRINT(EVAL(READ(input), env));
}

malValuePtr READ(const String& input)
{
    return readStr(input);
}

malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
{
    if (!env) {
        env = replEnv;
    }
    while (1) {
        const malList* list = DYNAMIC_CAST(malList, ast);
        if (!list || (list->count() == 0)) {
            return ast->eval(env);
        }

        ast = macroExpand(ast, env);
        list = DYNAMIC_CAST(malList, ast);
        if (!list || (list->count() == 0)) {
            return ast->eval(env);
        }

        // From here on down we are evaluating a non-empty list.
        // First handle the special forms.
        if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) {
            String special = symbol->value();
            int argCount = list->count() - 1;

            if (special == "def!") {
                checkArgsIs("def!", 2, argCount);
                const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
                return env->set(id->value(), EVAL(list->item(2), env));
            }

            if (special == "defmacro!") {
                checkArgsIs("defmacro!", 2, argCount);

                const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
                malValuePtr body = EVAL(list->item(2), env);
                const malLambda* lambda = VALUE_CAST(malLambda, body);
                return env->set(id->value(), mal::macro(*lambda));
            }

            if (special == "do") {
                checkArgsAtLeast("do", 1, argCount);

                for (int i = 1; i < argCount; i++) {
                    EVAL(list->item(i), env);
                }
                ast = list->item(argCount);
                continue; // TCO
            }

            if (special == "fn*") {
                checkArgsIs("fn*", 2, argCount);

                const malSequence* bindings =
                    VALUE_CAST(malSequence, list->item(1));
                StringVec params;
                for (int i = 0; i < bindings->count(); i++) {
                    const malSymbol* sym =
                        VALUE_CAST(malSymbol, bindings->item(i));
                    params.push_back(sym->value());
                }

                return mal::lambda(params, list->item(2), env);
            }

            if (special == "if") {
                checkArgsBetween("if", 2, 3, argCount);

                bool isTrue = EVAL(list->item(1), env)->isTrue();
                if (!isTrue && (argCount == 2)) {
                    return mal::nilValue();
                }
                ast = list->item(isTrue ? 2 : 3);
                continue; // TCO
            }

            if (special == "let*") {
                checkArgsIs("let*", 2, argCount);
                const malSequence* bindings =
                    VALUE_CAST(malSequence, list->item(1));
                int count = checkArgsEven("let*", bindings->count());
                malEnvPtr inner(new malEnv(env));
                for (int i = 0; i < count; i += 2) {
                    const malSymbol* var =
                        VALUE_CAST(malSymbol, bindings->item(i));
                    inner->set(var->value(), EVAL(bindings->item(i+1), inner));
                }
                ast = list->item(2);
                env = inner;
                continue; // TCO
            }

            if (special == "macroexpand") {
                checkArgsIs("macroexpand", 1, argCount);
                return macroExpand(list->item(1), env);
            }

            if (special == "quasiquoteexpand") {
                checkArgsIs("quasiquote", 1, argCount);
                return quasiquote(list->item(1));
            }

            if (special == "quasiquote") {
                checkArgsIs("quasiquote", 1, argCount);
                ast = quasiquote(list->item(1));
                continue; // TCO
            }

            if (special == "quote") {
                checkArgsIs("quote", 1, argCount);
                return list->item(1);
            }

            if (special == "try*") {
                malValuePtr tryBody = list->item(1);

                if (argCount == 1) {
                    ast = EVAL(tryBody, env);
                    continue; // TCO
                }
                checkArgsIs("try*", 2, argCount);
                const malList* catchBlock = VALUE_CAST(malList, list->item(2));

                checkArgsIs("catch*", 2, catchBlock->count() - 1);
                MAL_CHECK(VALUE_CAST(malSymbol,
                    catchBlock->item(0))->value() == "catch*",
                    "catch block must begin with catch*");

                // We don't need excSym at this scope, but we want to check
                // that the catch block is valid always, not just in case of
                // an exception.
                const malSymbol* excSym =
                    VALUE_CAST(malSymbol, catchBlock->item(1));

                malValuePtr excVal;

                try {
                    ast = EVAL(tryBody, env);
                }
                catch(String& s) {
                    excVal = mal::string(s);
                }
                catch (malEmptyInputException&) {
                    // Not an error, continue as if we got nil
                    ast = mal::nilValue();
                }
                catch(malValuePtr& o) {
                    excVal = o;
                };

                if (excVal) {
                    // we got some exception
                    env = malEnvPtr(new malEnv(env));
                    env->set(excSym->value(), excVal);
                    ast = catchBlock->item(2);
                }
                continue; // TCO
            }
        }

        // Now we're left with the case of a regular list to be evaluated.
        std::unique_ptr<malValueVec> items(list->evalItems(env));
        malValuePtr op = items->at(0);
        if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) {
            ast = lambda->getBody();
            env = lambda->makeEnv(items->begin()+1, items->end());
            continue; // TCO
        }
        else {
            return APPLY(op, items->begin()+1, items->end());
        }
    }
}

String PRINT(malValuePtr ast)
{
    return ast->print(true);
}

malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd)
{
    const malApplicable* handler = DYNAMIC_CAST(malApplicable, op);
    MAL_CHECK(handler != NULL,
              "\"%s\" is not applicable", op->print(true).c_str());

    return handler->apply(argsBegin, argsEnd);
}

static bool isSymbol(malValuePtr obj, const String& text)
{
    const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj);
    return sym && (sym->value() == text);
}

//  Return arg when ast matches ('sym, arg), else NULL.
static malValuePtr starts_with(const malValuePtr ast, const char* sym)
{
    const malList* list = DYNAMIC_CAST(malList, ast);
    if (!list || list->isEmpty() || !isSymbol(list->item(0), sym))
        return NULL;
    checkArgsIs(sym, 1, list->count() - 1);
    return list->item(1);
}

static malValuePtr quasiquote(malValuePtr obj)
{
    if (DYNAMIC_CAST(malSymbol, obj) || DYNAMIC_CAST(malHash, obj))
        return mal::list(mal::symbol("quote"), obj);

    const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
    if (!seq)
        return obj;

    const malValuePtr unquoted = starts_with(obj, "unquote");
    if (unquoted)
        return unquoted;

    malValuePtr res = mal::list(new malValueVec(0));
    for (int i=seq->count()-1; 0<=i; i--) {
        const malValuePtr elt     = seq->item(i);
        const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
        if (spl_unq)
            res = mal::list(mal::symbol("concat"), spl_unq, res);
         else
            res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
    }
    if (DYNAMIC_CAST(malVector, obj))
        res = mal::list(mal::symbol("vec"), res);
    return res;
}

static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
{
    const malList* seq = DYNAMIC_CAST(malList, obj);
    if (seq && !seq->isEmpty()) {
        if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
            if (malEnvPtr symEnv = env->find(sym->value())) {
                malValuePtr value = sym->eval(symEnv);
                if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
                    return lambda->isMacro() ? lambda : NULL;
                }
            }
        }
    }
    return NULL;
}

static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
{
    while (const malLambda* macro = isMacroApplication(obj, env)) {
        const malSequence* seq = STATIC_CAST(malSequence, obj);
        obj = macro->apply(seq->begin() + 1, seq->end());
    }
    return obj;
}

static const char* malFunctionTable[] = {
    "(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)))))))",
    "(def! not (fn* (cond) (if cond false true)))",
    "(def! load-file (fn* (filename) \
        (eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))",
};

static void installFunctions(malEnvPtr env) {
    for (auto &function : malFunctionTable) {
        rep(function, env);
    }
}

// Added to keep the linker happy at step A
malValuePtr readline(const String& prompt)
{
    String input;
    if (s_readLine.get(prompt, input)) {
        return mal::string(input);
    }
    return mal::nilValue();
}
Commit	Line	Data
2f61492a ST	1	#include "MAL.h"
	2
	3	#include "Environment.h"
	4	#include "ReadLine.h"
	5	#include "Types.h"
	6
	7	#include <iostream>
	8	#include <memory>
	9
	10	malValuePtr READ(const String& input);
	11	String PRINT(malValuePtr ast);
	12	static void installFunctions(malEnvPtr env);
ef1de022	13	// Installs functions and macros implemented in MAL.
2f61492a ST	14
2f61492a ST	15	static void makeArgv(malEnvPtr env, int argc, char* argv[]);
2f8f48e1	16	static String safeRep(const String& input, malEnvPtr env);
2f61492a ST	17	static malValuePtr quasiquote(malValuePtr obj);
2f61492a ST	18	static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env);
2f61492a ST	19
	20	static ReadLine s_readLine("~/.mal-history");
	21
494c1608 ST	22	static malEnvPtr replEnv(new malEnv);
494c1608 ST	23
2f61492a ST	24	int main(int argc, char* argv[])
	25	{
	26	String prompt = "user> ";
	27	String input;
2f61492a ST	28	installCore(replEnv);
2f61492a ST	29	installFunctions(replEnv);
2f61492a ST	30	makeArgv(replEnv, argc - 2, argv + 2);
	31	if (argc > 1) {
	32	String filename = escape(argv[1]);
	33	safeRep(STRF("(load-file %s)", filename.c_str()), replEnv);
	34	return 0;
	35	}
	36	while (s_readLine.get(prompt, input)) {
2f8f48e1 DM	37	String out = safeRep(input, replEnv);
	38	if (out.length() > 0)
	39	std::cout << out << "\n";
2f61492a ST	40	}
	41	return 0;
	42	}
	43
2f8f48e1	44	static String safeRep(const String& input, malEnvPtr env)
2f61492a	45	{
2f61492a	46	try {
2f8f48e1	47	return rep(input, env);
2f61492a ST	48	}
2f61492a ST	49	catch (malEmptyInputException&) {
2f8f48e1	50	return String();
2f61492a	51	}
dd7a4f55 JM	52	catch (malValuePtr& mv) {
	53	return "Error: " + mv->print(true);
	54	}
2f61492a	55	catch (String& s) {
dd7a4f55	56	return "Error: " + s;
2f61492a	57	};
2f61492a ST	58	}
	59
	60	static void makeArgv(malEnvPtr env, int argc, char* argv[])
	61	{
	62	malValueVec* args = new malValueVec();
	63	for (int i = 0; i < argc; i++) {
	64	args->push_back(mal::string(argv[i]));
	65	}
	66	env->set("ARGV", mal::list(args));
	67	}
	68
	69	String rep(const String& input, malEnvPtr env)
	70	{
	71	return PRINT(EVAL(READ(input), env));
	72	}
	73
	74	malValuePtr READ(const String& input)
	75	{
	76	return readStr(input);
	77	}
	78
	79	malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
	80	{
494c1608 ST	81	if (!env) {
	82	env = replEnv;
	83	}
2f61492a ST	84	while (1) {
	85	const malList* list = DYNAMIC_CAST(malList, ast);
	86	if (!list \|\| (list->count() == 0)) {
	87	return ast->eval(env);
	88	}
	89
	90	ast = macroExpand(ast, env);
	91	list = DYNAMIC_CAST(malList, ast);
	92	if (!list \|\| (list->count() == 0)) {
	93	return ast->eval(env);
	94	}
	95
	96	// From here on down we are evaluating a non-empty list.
	97	// First handle the special forms.
	98	if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) {
	99	String special = symbol->value();
	100	int argCount = list->count() - 1;
	101
	102	if (special == "def!") {
	103	checkArgsIs("def!", 2, argCount);
	104	const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
	105	return env->set(id->value(), EVAL(list->item(2), env));
	106	}
	107
	108	if (special == "defmacro!") {
	109	checkArgsIs("defmacro!", 2, argCount);
	110
	111	const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
	112	malValuePtr body = EVAL(list->item(2), env);
	113	const malLambda* lambda = VALUE_CAST(malLambda, body);
	114	return env->set(id->value(), mal::macro(*lambda));
	115	}
	116
	117	if (special == "do") {
	118	checkArgsAtLeast("do", 1, argCount);
	119
	120	for (int i = 1; i < argCount; i++) {
	121	EVAL(list->item(i), env);
	122	}
	123	ast = list->item(argCount);
	124	continue; // TCO
	125	}
	126
	127	if (special == "fn*") {
	128	checkArgsIs("fn*", 2, argCount);
	129
	130	const malSequence* bindings =
	131	VALUE_CAST(malSequence, list->item(1));
	132	StringVec params;
	133	for (int i = 0; i < bindings->count(); i++) {
	134	const malSymbol* sym =
	135	VALUE_CAST(malSymbol, bindings->item(i));
	136	params.push_back(sym->value());
	137	}
	138
	139	return mal::lambda(params, list->item(2), env);
	140	}
	141
	142	if (special == "if") {
	143	checkArgsBetween("if", 2, 3, argCount);
	144
	145	bool isTrue = EVAL(list->item(1), env)->isTrue();
	146	if (!isTrue && (argCount == 2)) {
	147	return mal::nilValue();
148	}
149	ast = list->item(isTrue ? 2 : 3);
150	continue; // TCO
151	}
152
153	if (special == "let*") {
154	checkArgsIs("let*", 2, argCount);
155	const malSequence* bindings =
156	VALUE_CAST(malSequence, list->item(1));
157	int count = checkArgsEven("let*", bindings->count());
158	malEnvPtr inner(new malEnv(env));
159	for (int i = 0; i < count; i += 2) {
160	const malSymbol* var =
161	VALUE_CAST(malSymbol, bindings->item(i));
162	inner->set(var->value(), EVAL(bindings->item(i+1), inner));
163	}
164	ast = list->item(2);
165	env = inner;
166	continue; // TCO
167	}
168
169	if (special == "macroexpand") {
170	checkArgsIs("macroexpand", 1, argCount);
171	return macroExpand(list->item(1), env);
172	}
173
fbfe6784 NB	174	if (special == "quasiquoteexpand") {
	175	checkArgsIs("quasiquote", 1, argCount);
	176	return quasiquote(list->item(1));
	177	}
	178
2f61492a ST	179	if (special == "quasiquote") {
	180	checkArgsIs("quasiquote", 1, argCount);
	181	ast = quasiquote(list->item(1));
	182	continue; // TCO
	183	}
	184
	185	if (special == "quote") {
	186	checkArgsIs("quote", 1, argCount);
	187	return list->item(1);
	188	}
	189
	190	if (special == "try*") {
2f61492a	191	malValuePtr tryBody = list->item(1);
5d991812 JM	192
	193	if (argCount == 1) {
	194	ast = EVAL(tryBody, env);
	195	continue; // TCO
	196	}
	197	checkArgsIs("try*", 2, argCount);
2f61492a ST	198	const malList* catchBlock = VALUE_CAST(malList, list->item(2));
	199
	200	checkArgsIs("catch*", 2, catchBlock->count() - 1);
0997015d	201	MAL_CHECK(VALUE_CAST(malSymbol,
2f61492a ST	202	catchBlock->item(0))->value() == "catch*",
	203	"catch block must begin with catch*");
	204
	205	// We don't need excSym at this scope, but we want to check
	206	// that the catch block is valid always, not just in case of
	207	// an exception.
	208	const malSymbol* excSym =
	209	VALUE_CAST(malSymbol, catchBlock->item(1));
	210
	211	malValuePtr excVal;
	212
	213	try {
	214	ast = EVAL(tryBody, env);
	215	}
	216	catch(String& s) {
	217	excVal = mal::string(s);
	218	}
	219	catch (malEmptyInputException&) {
	220	// Not an error, continue as if we got nil
	221	ast = mal::nilValue();
	222	}
	223	catch(malValuePtr& o) {
	224	excVal = o;
	225	};
	226
	227	if (excVal) {
	228	// we got some exception
	229	env = malEnvPtr(new malEnv(env));
	230	env->set(excSym->value(), excVal);
	231	ast = catchBlock->item(2);
	232	}
	233	continue; // TCO
	234	}
	235	}
	236
	237	// Now we're left with the case of a regular list to be evaluated.
	238	std::unique_ptr<malValueVec> items(list->evalItems(env));
	239	malValuePtr op = items->at(0);
	240	if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) {
	241	ast = lambda->getBody();
	242	env = lambda->makeEnv(items->begin()+1, items->end());
	243	continue; // TCO
	244	}
	245	else {
494c1608	246	return APPLY(op, items->begin()+1, items->end());
2f61492a ST	247	}
	248	}
	249	}
	250
	251	String PRINT(malValuePtr ast)
	252	{
	253	return ast->print(true);
	254	}
	255
494c1608	256	malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd)
2f61492a ST	257	{
2f61492a ST	258	const malApplicable* handler = DYNAMIC_CAST(malApplicable, op);
0997015d ST	259	MAL_CHECK(handler != NULL,
0997015d ST	260	"\"%s\" is not applicable", op->print(true).c_str());
2f61492a	261
494c1608	262	return handler->apply(argsBegin, argsEnd);
2f61492a ST	263	}
	264
	265	static bool isSymbol(malValuePtr obj, const String& text)
	266	{
	267	const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj);
	268	return sym && (sym->value() == text);
	269	}
	270
fbfe6784 NB	271	// Return arg when ast matches ('sym, arg), else NULL.
fbfe6784 NB	272	static malValuePtr starts_with(const malValuePtr ast, const char* sym)
2f61492a	273	{
fbfe6784 NB	274	const malList* list = DYNAMIC_CAST(malList, ast);
	275	if (!list \|\| list->isEmpty() \|\| !isSymbol(list->item(0), sym))
	276	return NULL;
	277	checkArgsIs(sym, 1, list->count() - 1);
	278	return list->item(1);
2f61492a ST	279	}
	280
	281	static malValuePtr quasiquote(malValuePtr obj)
	282	{
fbfe6784	283	if (DYNAMIC_CAST(malSymbol, obj) \|\| DYNAMIC_CAST(malHash, obj))
2f61492a	284	return mal::list(mal::symbol("quote"), obj);
2f61492a	285
fbfe6784 NB	286	const malSequence* seq = DYNAMIC_CAST(malSequence, obj);
	287	if (!seq)
	288	return obj;
	289
	290	const malValuePtr unquoted = starts_with(obj, "unquote");
	291	if (unquoted)
	292	return unquoted;
	293
	294	malValuePtr res = mal::list(new malValueVec(0));
	295	for (int i=seq->count()-1; 0<=i; i--) {
	296	const malValuePtr elt = seq->item(i);
	297	const malValuePtr spl_unq = starts_with(elt, "splice-unquote");
	298	if (spl_unq)
	299	res = mal::list(mal::symbol("concat"), spl_unq, res);
	300	else
	301	res = mal::list(mal::symbol("cons"), quasiquote(elt), res);
2f61492a	302	}
fbfe6784 NB	303	if (DYNAMIC_CAST(malVector, obj))
	304	res = mal::list(mal::symbol("vec"), res);
	305	return res;
2f61492a ST	306	}
	307
	308	static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
	309	{
fbfe6784 NB	310	const malList* seq = DYNAMIC_CAST(malList, obj);
	311	if (seq && !seq->isEmpty()) {
	312	if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) {
2f61492a ST	313	if (malEnvPtr symEnv = env->find(sym->value())) {
	314	malValuePtr value = sym->eval(symEnv);
	315	if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
	316	return lambda->isMacro() ? lambda : NULL;
	317	}
	318	}
	319	}
	320	}
	321	return NULL;
	322	}
	323
	324	static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
	325	{
	326	while (const malLambda* macro = isMacroApplication(obj, env)) {
	327	const malSequence* seq = STATIC_CAST(malSequence, obj);
494c1608	328	obj = macro->apply(seq->begin() + 1, seq->end());
2f61492a ST	329	}
	330	return obj;
	331	}
	332
ef1de022	333	static const char* malFunctionTable[] = {
2f61492a	334	"(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)))))))",
2f61492a	335	"(def! not (fn* (cond) (if cond false true)))",
2f61492a	336	"(def! load-file (fn* (filename) \
e6d41de4	337	(eval (read-string (str \"(do \" (slurp filename) \"\nnil)\")))))",
2f61492a ST	338	};
	339
	340	static void installFunctions(malEnvPtr env) {
f01c2683 ST	341	for (auto &function : malFunctionTable) {
f01c2683 ST	342	rep(function, env);
2f61492a ST	343	}
2f61492a ST	344	}
cb252845 ST	345
	346	// Added to keep the linker happy at step A
	347	malValuePtr readline(const String& prompt)
	348	{
	349	String input;
	350	if (s_readLine.get(prompt, input)) {
	351	return mal::string(input);
	352	}
	353	return mal::nilValue();
	354	}
	355