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