impls/io/step8_macros.io

   1 MalTypes
   2 MalReader
   3
   4 READ := method(str, MalReader read_str(str))
   5
   6 qq_foldr := method(xs,
   7     xs reverseReduce(acc, elt,
   8         if((elt type == "MalList") and (elt size == 2) and (elt at(0) == MalSymbol with("splice-unquote")),
   9             MalList with(list(MalSymbol with("concat"), elt at(1), acc)),
  10             MalList with(list(MalSymbol with("cons"), quasiquote(elt), acc))),
  11         MalList with(list())))
  12
  13 quasiquote := method(ast,
  14     ast type switch(
  15         "MalSymbol", MalList with(list(MalSymbol with("quote"), ast)),
  16         "MalMap",    MalList with(list(MalSymbol with("quote"), ast)),
  17         "MalVector", MalList with(list(MalSymbol with("vec"), qq_foldr(ast))),
  18         "MalList",   if((ast size == 2) and (ast at(0) == MalSymbol with("unquote")),
  19                          ast at(1),
  20                          qq_foldr(ast)),
  21         ast))
  22
  23 isMacroCall := method(ast, env,
  24     if(ast type != "MalList", return false)
  25     a0 := ast first
  26     if(a0 type != "MalSymbol", return false)
  27     if(env find(a0) isNil, return false)
  28     f := env get(a0)
  29     (f type == "MalFunc") and (f isMacro)
  30 )
  31
  32 macroexpand := method(ast, env,
  33     while(isMacroCall(ast, env),
  34         macro := env get(ast at(0))
  35         ast = macro blk call(ast rest)
  36     )
  37     ast
  38 )
  39
  40 eval_ast := method(ast, env,
  41    (ast type) switch(
  42        "MalSymbol", env get(ast),
  43        "MalList", MalList with(ast map(a, EVAL(a, env))),
  44        "MalVector", MalVector with(ast map(a, EVAL(a, env))),
  45        "MalMap",
  46            m := MalMap clone
  47            ast foreach(k, v,
  48                keyObj := MalMap keyToObj(k)
  49                m atPut(MalMap objToKey(EVAL(keyObj, env)), EVAL(v, env))
  50            )
  51            m,
  52        ast
  53    )
  54 )
  55
  56 EVAL := method(ast, env,
  57     loop(
  58         if(ast type != "MalList", return(eval_ast(ast, env)))
  59
  60         ast = macroexpand(ast, env)
  61         if(ast type != "MalList", return(eval_ast(ast, env)))
  62         if(ast isEmpty, return ast)
  63
  64         if(ast at(0) type == "MalSymbol",
  65             ast at(0) val switch(
  66                 "def!",
  67                     return(env set(ast at(1), EVAL(ast at(2), env))),
  68                 "do",
  69                     eval_ast(ast slice(1,-1), env)
  70                     ast = ast last
  71                     continue, // TCO
  72                 "if",
  73                     ast = if(EVAL(ast at(1), env), ast at(2), ast at(3))
  74                     continue, // TCO
  75                 "fn*",
  76                     return(MalFunc with(ast at(2), ast at(1), env, block(a, EVAL(ast at(2), Env with(env, ast at(1), a))))),
  77                 "let*",
  78                     letEnv := Env with(env)
  79                     varName := nil
  80                     ast at(1) foreach(i, e,
  81                         if(i % 2 == 0,
  82                             varName := e,
  83                             letEnv set(varName, EVAL(e, letEnv))
  84                         )
  85                     )
  86                     ast = ast at(2)
  87                     env = letEnv
  88                     continue, // TCO
  89                 "quote",
  90                     return(ast at(1)),
  91                 "quasiquoteexpand",
  92                     return quasiquote(ast at(1)),
  93                 "quasiquote",
  94                     ast = quasiquote(ast at(1))
  95                     continue, // TCO
  96                 "defmacro!",
  97                     return(env set(ast at(1), EVAL(ast at(2), env) clone setIsMacro(true))),
  98                 "macroexpand",
  99                     return(macroexpand(ast at(1), env))
 100             )
 101         )
 102
 103         // Apply
 104         el := eval_ast(ast, env)
 105         f := el at(0)
 106         args := el rest
 107         f type switch(
 108             "Block",
 109                 return(f call(args)),
 110             "MalFunc",
 111                 ast = f ast
 112                 env = Env with(f env, f params, args)
 113                 continue, // TCO
 114             Exception raise("Unknown function type")
 115         )
 116     )
 117 )
 118
 119 PRINT := method(exp, exp malPrint(true))
 120
 121 repl_env := Env with(nil)
 122
 123 RE := method(str, EVAL(READ(str), repl_env))
 124
 125 REP := method(str, PRINT(RE(str)))
 126
 127 MalCore NS foreach(k, v, repl_env set(MalSymbol with(k), v))
 128 repl_env set(MalSymbol with("eval"), block(a, EVAL(a at(0), repl_env)))
 129 repl_env set(MalSymbol with("*ARGV*"), MalList with(System args slice(2)))
 130
 131 // core.mal: defined using the language itself
 132 RE("(def! not (fn* (a) (if a false true)))")
 133 RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))")
 134 RE("(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)))))))")
 135
 136 if(System args size > 1,
 137     REP("(load-file \"" .. (System args at(1)) .. "\")")
 138     System exit(0)
 139 )
 140
 141 loop(
 142     line := MalReadline readLine("user> ")
 143     if(line isNil, break)
 144     if(line isEmpty, continue)
 145     e := try(REP(line) println)
 146     e catch(Exception,
 147         if(e type == "MalException",
 148             ("Error: " .. ((e val) malPrint(true))) println,
 149             ("Error: " .. (e error)) println
 150         )
 151     )
 152 )