pike/step8_macros.pike

   1 import .Env;
   2 import .Printer;
   3 import .Reader;
   4 import .Readline;
   5 import .Types;
   6
   7 Val READ(string str)
   8 {
   9   return read_str(str);
  10 }
  11
  12 bool is_pair(Val e)
  13 {
  14   return e.is_sequence && !e.emptyp();
  15 }
  16
  17 Val quasiquote(Val ast)
  18 {
  19   if(!is_pair(ast)) return List(({ Symbol("quote"), ast }));
  20   Val ast0 = ast.data[0];
  21   if(ast0.mal_type == MALTYPE_SYMBOL && ast0.value == "unquote") return ast.data[1];
  22   if(is_pair(ast0) && ast0.data[0].mal_type == MALTYPE_SYMBOL && ast0.data[0].value == "splice-unquote")
  23   {
  24     return List(({ Symbol("concat"), ast0.data[1], quasiquote(ast.rest()) }));
  25   }
  26   return List(({ Symbol("cons"), quasiquote(ast0), quasiquote(ast.rest()) }));
  27 }
  28
  29 bool is_macro_call(Val ast, Env env)
  30 {
  31   if(ast.mal_type == MALTYPE_LIST &&
  32      !ast.emptyp() &&
  33      ast.data[0].mal_type == MALTYPE_SYMBOL &&
  34      env.find(ast.data[0]))
  35   {
  36     Val v = env.get(ast.data[0]);
  37     if(objectp(v) && v.macro) return true;
  38   }
  39   return false;
  40 }
  41
  42 Val macroexpand(Val ast, Env env)
  43 {
  44   while(is_macro_call(ast, env))
  45   {
  46     Val macro = env.get(ast.data[0]);
  47     ast = macro(@ast.data[1..]);
  48   }
  49   return ast;
  50 }
  51
  52 Val eval_ast(Val ast, Env env)
  53 {
  54   switch(ast.mal_type)
  55   {
  56     case MALTYPE_SYMBOL:
  57       return env.get(ast);
  58     case MALTYPE_LIST:
  59       return List(map(ast.data, lambda(Val e) { return EVAL(e, env); }));
  60     case MALTYPE_VECTOR:
  61       return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); }));
  62     case MALTYPE_MAP:
  63       array(Val) elements = ({ });
  64       foreach(ast.data; Val k; Val v)
  65       {
  66         elements += ({ k, EVAL(v, env) });
  67       }
  68       return Map(elements);
  69     default:
  70       return ast;
  71   }
  72 }
  73
  74 Val EVAL(Val ast, Env env)
  75 {
  76   while(true)
  77   {
  78     if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env);
  79     ast = macroexpand(ast, env);
  80     if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env);
  81     if(ast.emptyp()) return ast;
  82     if(ast.data[0].mal_type == MALTYPE_SYMBOL) {
  83       switch(ast.data[0].value)
  84       {
  85         case "def!":
  86           return env.set(ast.data[1], EVAL(ast.data[2], env));
  87         case "let*":
  88           Env let_env = Env(env);
  89           Val ast1 = ast.data[1];
  90           for(int i = 0; i < sizeof(ast1.data); i += 2)
  91           {
  92             let_env.set(ast1.data[i], EVAL(ast1.data[i + 1], let_env));
  93           }
  94           env = let_env;
  95           ast = ast.data[2];
  96           continue; // TCO
  97         case "quote":
  98           return ast.data[1];
  99         case "quasiquote":
 100           ast = quasiquote(ast.data[1]);
 101           continue; // TCO
 102         case "defmacro!":
 103           Val macro = EVAL(ast.data[2], env).clone_as_macro();
 104           return env.set(ast.data[1], macro);
 105         case "macroexpand":
 106           return macroexpand(ast.data[1], env);
 107         case "do":
 108           Val result;
 109           foreach(ast.data[1..(sizeof(ast.data) - 2)], Val element)
 110           {
 111             result = EVAL(element, env);
 112           }
 113           ast = ast.data[-1];
 114           continue; // TCO
 115         case "if":
 116           Val cond = EVAL(ast.data[1], env);
 117           if(cond.mal_type == MALTYPE_FALSE || cond.mal_type == MALTYPE_NIL)
 118           {
 119             if(sizeof(ast.data) > 3)
 120               ast = ast.data[3];
 121             else
 122               return MAL_NIL;
 123           }
 124           else
 125             ast = ast.data[2];
 126           continue; // TCO
 127         case "fn*":
 128           return Fn(ast.data[2], ast.data[1], env,
 129                     lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); });
 130       }
 131     }
 132     Val evaled_ast = eval_ast(ast, env);
 133     Val f = evaled_ast.data[0];
 134     switch(f.mal_type)
 135     {
 136       case MALTYPE_BUILTINFN:
 137         return f(@evaled_ast.data[1..]);
 138       case MALTYPE_FN:
 139         ast = f.ast;
 140         env = Env(f.env, f.params, List(evaled_ast.data[1..]));
 141         continue; // TCO
 142       default:
 143         throw("Unknown function type");
 144     }
 145   }
 146 }
 147
 148 string PRINT(Val exp)
 149 {
 150   return pr_str(exp, true);
 151 }
 152
 153 string rep(string str, Env env)
 154 {
 155   return PRINT(EVAL(READ(str), env));
 156 }
 157
 158 int main(int argc, array argv)
 159 {
 160   Env repl_env = Env(0);
 161   foreach(.Core.NS(); Val k; Val v) repl_env.set(k, v);
 162   repl_env.set(Symbol("eval"), BuiltinFn("eval", lambda(Val a) { return EVAL(a, repl_env); }));
 163   repl_env.set(Symbol("*ARGV*"), List(map(argv[2..], String)));
 164   rep("(def! not (fn* (a) (if a false true)))", repl_env);
 165   rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env);
 166   rep("(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)))))))", repl_env);
 167   if(argc >= 2)
 168   {
 169     rep("(load-file \"" + argv[1] + "\")", repl_env);
 170     return 0;
 171   }
 172   while(1)
 173   {
 174     string line = readline("user> ");
 175     if(!line) break;
 176     if(strlen(line) == 0) continue;
 177     if(mixed err = catch { write(({ rep(line, repl_env), "\n" })); } )
 178     {
 179       if(arrayp(err)) err = err[0];
 180       write(({ "Error: ", err, "\n" }));
 181     }
 182   }
 183   write("\n");
 184   return 0;
 185 }