io/stepA_mal.io

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