cpp/step8_macros.cpp

   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);
  13
  14 static void makeArgv(malEnvPtr env, int argc, char* argv[]);
  15 static void safeRep(const String& input, malEnvPtr env);
  16 static malValuePtr quasiquote(malValuePtr obj);
  17 static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env);
  18 static void installMacros(malEnvPtr env);
  19
  20 static ReadLine s_readLine("~/.mal-history");
  21
  22 static malEnvPtr replEnv(new malEnv);
  23
  24 int main(int argc, char* argv[])
  25 {
  26     String prompt = "user> ";
  27     String input;
  28     installCore(replEnv);
  29     installFunctions(replEnv);
  30     installMacros(replEnv);
  31     makeArgv(replEnv, argc - 2, argv + 2);
  32     if (argc > 1) {
  33         String filename = escape(argv[1]);
  34         safeRep(STRF("(load-file %s)", filename.c_str()), replEnv);
  35         return 0;
  36     }
  37     while (s_readLine.get(prompt, input)) {
  38         safeRep(input, replEnv);
  39     }
  40     return 0;
  41 }
  42
  43 static void safeRep(const String& input, malEnvPtr env)
  44 {
  45     String out;
  46     try {
  47         out = rep(input, env);
  48     }
  49     catch (malEmptyInputException&) {
  50         return;
  51     }
  52     catch (String& s) {
  53         out = s;
  54     };
  55     std::cout << out << "\n";
  56 }
  57
  58 static void makeArgv(malEnvPtr env, int argc, char* argv[])
  59 {
  60     malValueVec* args = new malValueVec();
  61     for (int i = 0; i < argc; i++) {
  62         args->push_back(mal::string(argv[i]));
  63     }
  64     env->set("*ARGV*", mal::list(args));
  65 }
  66
  67 String rep(const String& input, malEnvPtr env)
  68 {
  69     return PRINT(EVAL(READ(input), env));
  70 }
  71
  72 malValuePtr READ(const String& input)
  73 {
  74     return readStr(input);
  75 }
  76
  77 malValuePtr EVAL(malValuePtr ast, malEnvPtr env)
  78 {
  79     if (!env) {
  80         env = replEnv;
  81     }
  82     while (1) {
  83         const malList* list = DYNAMIC_CAST(malList, ast);
  84         if (!list || (list->count() == 0)) {
  85             return ast->eval(env);
  86         }
  87
  88         ast = macroExpand(ast, env);
  89         list = DYNAMIC_CAST(malList, ast);
  90         if (!list || (list->count() == 0)) {
  91             return ast->eval(env);
  92         }
  93
  94         // From here on down we are evaluating a non-empty list.
  95         // First handle the special forms.
  96         if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) {
  97             String special = symbol->value();
  98             int argCount = list->count() - 1;
  99
 100             if (special == "def!") {
 101                 checkArgsIs("def!", 2, argCount);
 102                 const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
 103                 return env->set(id->value(), EVAL(list->item(2), env));
 104             }
 105
 106             if (special == "defmacro!") {
 107                 checkArgsIs("defmacro!", 2, argCount);
 108
 109                 const malSymbol* id = VALUE_CAST(malSymbol, list->item(1));
 110                 malValuePtr body = EVAL(list->item(2), env);
 111                 const malLambda* lambda = VALUE_CAST(malLambda, body);
 112                 return env->set(id->value(), mal::macro(*lambda));
 113             }
 114
 115             if (special == "do") {
 116                 checkArgsAtLeast("do", 1, argCount);
 117
 118                 for (int i = 1; i < argCount; i++) {
 119                     EVAL(list->item(i), env);
 120                 }
 121                 ast = list->item(argCount);
 122                 continue; // TCO
 123             }
 124
 125             if (special == "fn*") {
 126                 checkArgsIs("fn*", 2, argCount);
 127
 128                 const malSequence* bindings =
 129                     VALUE_CAST(malSequence, list->item(1));
 130                 StringVec params;
 131                 for (int i = 0; i < bindings->count(); i++) {
 132                     const malSymbol* sym =
 133                         VALUE_CAST(malSymbol, bindings->item(i));
 134                     params.push_back(sym->value());
 135                 }
 136
 137                 return mal::lambda(params, list->item(2), env);
 138             }
 139
 140             if (special == "if") {
 141                 checkArgsBetween("if", 2, 3, argCount);
 142
 143                 bool isTrue = EVAL(list->item(1), env)->isTrue();
 144                 if (!isTrue && (argCount == 2)) {
 145                     return mal::nilValue();
 146                 }
 147                 ast = list->item(isTrue ? 2 : 3);
 148                 continue; // TCO
 149             }
 150
 151             if (special == "let*") {
 152                 checkArgsIs("let*", 2, argCount);
 153                 const malSequence* bindings =
 154                     VALUE_CAST(malSequence, list->item(1));
 155                 int count = checkArgsEven("let*", bindings->count());
 156                 malEnvPtr inner(new malEnv(env));
 157                 for (int i = 0; i < count; i += 2) {
 158                     const malSymbol* var =
 159                         VALUE_CAST(malSymbol, bindings->item(i));
 160                     inner->set(var->value(), EVAL(bindings->item(i+1), inner));
 161                 }
 162                 ast = list->item(2);
 163                 env = inner;
 164                 continue; // TCO
 165             }
 166
 167             if (special == "macroexpand") {
 168                 checkArgsIs("macroexpand", 1, argCount);
 169                 return macroExpand(list->item(1), env);
 170             }
 171
 172             if (special == "quasiquote") {
 173                 checkArgsIs("quasiquote", 1, argCount);
 174                 ast = quasiquote(list->item(1));
 175                 continue; // TCO
 176             }
 177
 178             if (special == "quote") {
 179                 checkArgsIs("quote", 1, argCount);
 180                 return list->item(1);
 181             }
 182         }
 183
 184         // Now we're left with the case of a regular list to be evaluated.
 185         std::unique_ptr<malValueVec> items(list->evalItems(env));
 186         malValuePtr op = items->at(0);
 187         if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) {
 188             ast = lambda->getBody();
 189             env = lambda->makeEnv(items->begin()+1, items->end());
 190             continue; // TCO
 191         }
 192         else {
 193             return APPLY(op, items->begin()+1, items->end());
 194         }
 195     }
 196 }
 197
 198 String PRINT(malValuePtr ast)
 199 {
 200     return ast->print(true);
 201 }
 202
 203 malValuePtr APPLY(malValuePtr op, malValueIter argsBegin, malValueIter argsEnd)
 204 {
 205     const malApplicable* handler = DYNAMIC_CAST(malApplicable, op);
 206     MAL_CHECK(handler != NULL,
 207               "\"%s\" is not applicable", op->print(true).c_str());
 208
 209     return handler->apply(argsBegin, argsEnd);
 210 }
 211
 212 static bool isSymbol(malValuePtr obj, const String& text)
 213 {
 214     const malSymbol* sym = DYNAMIC_CAST(malSymbol, obj);
 215     return sym && (sym->value() == text);
 216 }
 217
 218 static const malSequence* isPair(malValuePtr obj)
 219 {
 220     const malSequence* list = DYNAMIC_CAST(malSequence, obj);
 221     return list && !list->isEmpty() ? list : NULL;
 222 }
 223
 224 static malValuePtr quasiquote(malValuePtr obj)
 225 {
 226     const malSequence* seq = isPair(obj);
 227     if (!seq) {
 228         return mal::list(mal::symbol("quote"), obj);
 229     }
 230
 231     if (isSymbol(seq->item(0), "unquote")) {
 232         // (qq (uq form)) -> form
 233         checkArgsIs("unquote", 1, seq->count() - 1);
 234         return seq->item(1);
 235     }
 236
 237     const malSequence* innerSeq = isPair(seq->item(0));
 238     if (innerSeq && isSymbol(innerSeq->item(0), "splice-unquote")) {
 239         checkArgsIs("splice-unquote", 1, innerSeq->count() - 1);
 240         // (qq (sq '(a b c))) -> a b c
 241         return mal::list(
 242             mal::symbol("concat"),
 243             innerSeq->item(1),
 244             quasiquote(seq->rest())
 245         );
 246     }
 247     else {
 248         // (qq (a b c)) -> (list (qq a) (qq b) (qq c))
 249         // (qq xs     ) -> (cons (qq (car xs)) (qq (cdr xs)))
 250         return mal::list(
 251             mal::symbol("cons"),
 252             quasiquote(seq->first()),
 253             quasiquote(seq->rest())
 254         );
 255     }
 256 }
 257
 258 static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env)
 259 {
 260     if (const malSequence* seq = isPair(obj)) {
 261         if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->first())) {
 262             if (malEnvPtr symEnv = env->find(sym->value())) {
 263                 malValuePtr value = sym->eval(symEnv);
 264                 if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) {
 265                     return lambda->isMacro() ? lambda : NULL;
 266                 }
 267             }
 268         }
 269     }
 270     return NULL;
 271 }
 272
 273 static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env)
 274 {
 275     while (const malLambda* macro = isMacroApplication(obj, env)) {
 276         const malSequence* seq = STATIC_CAST(malSequence, obj);
 277         obj = macro->apply(seq->begin() + 1, seq->end());
 278     }
 279     return obj;
 280 }
 281
 282 static const char* macroTable[] = {
 283     "(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)))))))",
 284     "(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))))))))",
 285 };
 286
 287 static void installMacros(malEnvPtr env)
 288 {
 289     for (auto &macro : macroTable) {
 290         rep(macro, env);
 291     }
 292 }
 293
 294 static const char* malFunctionTable[] = {
 295     "(def! list (fn* (& items) items))",
 296     "(def! not (fn* (cond) (if cond false true)))",
 297     "(def! >= (fn* (a b) (<= b a)))",
 298     "(def! < (fn* (a b) (not (<= b a))))",
 299     "(def! > (fn* (a b) (not (<= a b))))",
 300     "(def! load-file (fn* (filename) \
 301         (eval (read-string (str \"(do \" (slurp filename) \")\")))))",
 302 };
 303
 304 static void installFunctions(malEnvPtr env) {
 305     for (auto &function : malFunctionTable) {
 306         rep(function, env);
 307     }
 308 }
 309
 310 // Added to keep the linker happy at step A
 311 malValuePtr readline(const String& prompt)
 312 {
 313     String input;
 314     if (s_readLine.get(prompt, input)) {
 315         return mal::string(input);
 316     }
 317     return mal::nilValue();
 318 }
 319