return mal::boolean(DYNAMIC_CAST(type, *argsBegin)); \
}
+#define BUILTIN_IS(op, constant) \
+ BUILTIN(op) { \
+ CHECK_ARGS_IS(1); \
+ return mal::boolean(*argsBegin == mal::constant()); \
+ }
+
#define BUILTIN_INTOP(op, checkDivByZero) \
BUILTIN(#op) { \
CHECK_ARGS_IS(2); \
return mal::integer(lhs->value() op rhs->value()); \
}
+BUILTIN_ISA("keyword?", malKeyword);
BUILTIN_ISA("list?", malList);
+BUILTIN_ISA("map?", malHash);
+BUILTIN_ISA("sequential?", malSequence);
+BUILTIN_ISA("symbol?", malSymbol);
+BUILTIN_ISA("vector?", malVector);
BUILTIN_INTOP(+, false);
BUILTIN_INTOP(/, true);
BUILTIN_INTOP(*, false);
BUILTIN_INTOP(%, true);
+BUILTIN_IS("true?", trueValue);
+BUILTIN_IS("false?", falseValue);
+BUILTIN_IS("nil?", nilValue);
+
BUILTIN("-")
{
int argCount = CHECK_ARGS_BETWEEN(1, 2);
return mal::boolean(lhs->isEqualTo(rhs));
}
+BUILTIN("apply")
+{
+ CHECK_ARGS_AT_LEAST(2);
+ malValuePtr op = *argsBegin++; // this gets checked in APPLY
+
+ // Copy the first N-1 arguments in.
+ malValueVec args(argsBegin, argsEnd-1);
+
+ // Then append the argument as a list.
+ const malSequence* lastArg = VALUE_CAST(malSequence, *(argsEnd-1));
+ for (int i = 0; i < lastArg->count(); i++) {
+ args.push_back(lastArg->item(i));
+ }
+
+ return APPLY(op, args.begin(), args.end(), env->getRoot());
+}
+
+BUILTIN("assoc")
+{
+ CHECK_ARGS_AT_LEAST(1);
+ ARG(malHash, hash);
+
+ return hash->assoc(argsBegin, argsEnd);
+}
+
BUILTIN("concat")
{
int count = 0;
return mal::list(items);
}
+BUILTIN("contains?")
+{
+ CHECK_ARGS_IS(2);
+ if (*argsBegin == mal::nilValue()) {
+ return *argsBegin;
+ }
+ ARG(malHash, hash);
+ return mal::boolean(hash->contains(*argsBegin));
+}
+
BUILTIN("count")
{
CHECK_ARGS_IS(1);
return mal::integer(seq->count());
}
+BUILTIN("dissoc")
+{
+ CHECK_ARGS_AT_LEAST(1);
+ ARG(malHash, hash);
+
+ return hash->dissoc(argsBegin, argsEnd);
+}
+
BUILTIN("empty?")
{
CHECK_ARGS_IS(1);
return seq->first();
}
+BUILTIN("get")
+{
+ CHECK_ARGS_IS(2);
+ if (*argsBegin == mal::nilValue()) {
+ return *argsBegin;
+ }
+ ARG(malHash, hash);
+ return hash->get(*argsBegin);
+}
+
BUILTIN("hash-map")
{
return mal::hash(argsBegin, argsEnd);
}
+BUILTIN("keys")
+{
+ CHECK_ARGS_IS(1);
+ ARG(malHash, hash);
+ return hash->keys();
+}
+
+BUILTIN("keyword")
+{
+ CHECK_ARGS_IS(1);
+ ARG(malString, token);
+ return mal::keyword(":" + token->value());
+}
+
BUILTIN("nth")
{
CHECK_ARGS_IS(2);
return mal::string(printValues(argsBegin, argsEnd, "", false));
}
+BUILTIN("symbol")
+{
+ CHECK_ARGS_IS(1);
+ ARG(malString, token);
+ return mal::symbol(token->value());
+}
+
+BUILTIN("throw")
+{
+ CHECK_ARGS_IS(1);
+ throw *argsBegin;
+}
+
+BUILTIN("vals")
+{
+ CHECK_ARGS_IS(1);
+ ARG(malHash, hash);
+ return hash->values();
+}
+
+BUILTIN("vector")
+{
+ return mal::vector(argsBegin, argsEnd);
+}
+
void installCore(malEnvPtr env) {
for (auto it = handlers.begin(), end = handlers.end(); it != end; ++it) {
malBuiltIn* handler = *it;
return malValuePtr(c);
};
+ malValuePtr hash(const malHash::Map& map) {
+ return malValuePtr(new malHash(map));
+ }
+
malValuePtr hash(malValueIter argsBegin, malValueIter argsEnd) {
return malValuePtr(new malHash(argsBegin, argsEnd));
}
malValuePtr vector(malValueVec* items) {
return malValuePtr(new malVector(items));
};
+
+ malValuePtr vector(malValueIter begin, malValueIter end) {
+ return malValuePtr(new malVector(begin, end));
+ };
};
malValuePtr malBuiltIn::apply(malValueIter argsBegin,
}
+malHash::malHash(const malHash::Map& map)
+: m_map(map)
+{
+
+}
+
+malValuePtr
+malHash::assoc(malValueIter argsBegin, malValueIter argsEnd) const
+{
+ ASSERT(std::distance(argsBegin, argsEnd) % 2 == 0,
+ "assoc requires an even-sized list");
+
+ malHash::Map map(m_map);
+ return mal::hash(addToMap(map, argsBegin, argsEnd));
+}
+
+bool malHash::contains(malValuePtr key) const
+{
+ auto it = m_map.find(makeHashKey(key));
+ return it != m_map.end();
+}
+
+malValuePtr
+malHash::dissoc(malValueIter argsBegin, malValueIter argsEnd) const
+{
+ malHash::Map map(m_map);
+ for (auto it = argsBegin; it != argsEnd; ++it) {
+ String key = makeHashKey(*it);
+ map.erase(key);
+ }
+ return mal::hash(map);
+}
+
+malValuePtr malHash::get(malValuePtr key) const
+{
+ auto it = m_map.find(makeHashKey(key));
+ return it == m_map.end() ? mal::nilValue() : it->second;
+}
+
+malValuePtr malHash::keys() const
+{
+ malValueVec* keys = new malValueVec();
+ keys->reserve(m_map.size());
+ for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) {
+ if (it->first[0] == '"') {
+ keys->push_back(mal::string(unescape(it->first)));
+ }
+ else {
+ keys->push_back(mal::keyword(it->first));
+ }
+ }
+ return mal::list(keys);
+}
+
+malValuePtr malHash::values() const
+{
+ malValueVec* keys = new malValueVec();
+ keys->reserve(m_map.size());
+ for (auto it = m_map.begin(), end = m_map.end(); it != end; ++it) {
+ keys->push_back(it->second);
+ }
+ return mal::list(keys);
+}
+
String malHash::print(bool readably) const
{
String s = "{";
--- /dev/null
+#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);
+
+static void makeArgv(malEnvPtr env, int argc, char* argv[]);
+static void safeRep(const String& input, malEnvPtr env);
+static malValuePtr quasiquote(malValuePtr obj);
+static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env);
+static void installMacros(malEnvPtr env);
+
+static ReadLine s_readLine("~/.mal-history");
+
+int main(int argc, char* argv[])
+{
+ String prompt = "user> ";
+ String input;
+ malEnvPtr replEnv(new malEnv);
+ installCore(replEnv);
+ installFunctions(replEnv);
+ installMacros(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)) {
+ safeRep(input, replEnv);
+ }
+ return 0;
+}
+
+static void safeRep(const String& input, malEnvPtr env)
+{
+ String out;
+ try {
+ out = rep(input, env);
+ }
+ catch (malEmptyInputException&) {
+ return;
+ }
+ catch (String& s) {
+ out = s;
+ };
+ std::cout << out << "\n";
+}
+
+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)
+{
+ 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 == "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*") {
+ checkArgsIs("try*", 2, argCount);
+ malValuePtr tryBody = list->item(1);
+ const malList* catchBlock = VALUE_CAST(malList, list->item(2));
+
+ checkArgsIs("catch*", 2, catchBlock->count() - 1);
+ ASSERT(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(), env);
+ }
+ }
+}
+
+String PRINT(malValuePtr ast)
+{
+ return ast->print(true);
+}
+
+malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd,
+ malEnvPtr env)
+{
+ const malApplicable* handler = DYNAMIC_CAST(malApplicable, op);
+ ASSERT(handler != NULL, "\"%s\" is not applicable", op->print(true).c_str());
+
+ return handler->apply(argsBegin, argsEnd, env);
+}
+
+static bool isSymbol(malValuePtr obj, const String& text)
+{
+ const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj);
+ return sym && (sym->value() == text);
+}
+
+static const malSequence* isPair(malValuePtr obj)
+{
+ const malSequence* list = DYNAMIC_CAST(malSequence, obj);
+ return list && !list->isEmpty() ? list : NULL;
+}
+
+static malValuePtr quasiquote(malValuePtr obj)
+{
+ const malSequence* seq = isPair(obj);
+ if (!seq) {
+ return mal::list(mal::symbol("quote"), obj);
+ }
+
+ if (isSymbol(seq->item(0), "unquote")) {
+ // (qq (uq form)) -> form
+ checkArgsIs("unquote", 1, seq->count() - 1);
+ return seq->item(1);
+ }
+
+ const malSequence* innerSeq = isPair(seq->item(0));
+ if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
+ checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
+ // (qq (sq '(a b c))) -> a b c
+ return mal::list(
+ mal::symbol("concat"),
+ innerSeq->item(1),
+ quasiquote(seq->rest())
+ );
+ }
+ else {
+ // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
+ // (qq xs ) -> (cons (qq (car xs)) (qq (cdr xs)))
+ return mal::list(
+ mal::symbol("cons"),
+ quasiquote(seq->first()),
+ quasiquote(seq->rest())
+ );
+ }
+}
+
+static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
+{
+ if (const malSequence* seq = isPair(obj)) {
+ if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
+ 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(), env);
+ }
+ return obj;
+}
+
+static const char* macroTable[] = {
+ "(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)))))))",
+ "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))",
+};
+
+static void installMacros(malEnvPtr env)
+{
+ for (int i = 0; i < ARRAY_SIZE(macroTable); i++) {
+ rep(macroTable[i], env);
+ }
+}
+
+static const char* malFunctionTable[] = {
+ "(def! list (fn* (& items) items))",
+ "(def! not (fn* (cond) (if cond false true)))",
+ "(def! >= (fn* (a b) (<= b a)))",
+ "(def! < (fn* (a b) (not (<= b a))))",
+ "(def! > (fn* (a b) (not (<= a b))))",
+ "(def! load-file (fn* (filename) \
+ (eval (read-string (str \"(do \" (slurp filename) \")\")))))",
+ "(def! map (fn* (f xs) (if (empty? xs) xs \
+ (cons (f (first xs)) (map f (rest xs))))))",
+};
+
+static void installFunctions(malEnvPtr env) {
+ for (int i = 0; i < ARRAY_SIZE(malFunctionTable); i++) {
+ rep(malFunctionTable[i], env);
+ }
+}
HCoop / jackhill / mal.git / commitdiff