vimscript/stepA_mal.vim

   1 source readline.vim
   2 source types.vim
   3 source reader.vim
   4 source printer.vim
   5 source env.vim
   6 source core.vim
   7
   8 let MalExceptionObj = ""
   9
  10 function READ(str)
  11   return ReadStr(a:str)
  12 endfunction
  13
  14 function PairQ(obj)
  15   return SequentialQ(a:obj) && !EmptyQ(a:obj)
  16 endfunction
  17
  18 function Quasiquote(ast)
  19   if !PairQ(a:ast)
  20     return ListNew([SymbolNew("quote"), a:ast])
  21   endif
  22   let a0 = ListFirst(a:ast)
  23   if SymbolQ(a0) && a0.val == "unquote"
  24     return ListNth(a:ast, 1)
  25   elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote"
  26     return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))])
  27   else
  28     return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))])
  29   end
  30 endfunction
  31
  32 function IsMacroCall(ast, env)
  33   if !ListQ(a:ast)
  34     return 0
  35   endif
  36   let a0 = ListFirst(a:ast)
  37   if !SymbolQ(a0)
  38     return 0
  39   endif
  40   let macroname = a0.val
  41   if empty(a:env.find(macroname))
  42     return 0
  43   endif
  44   return MacroQ(a:env.get(macroname))
  45 endfunction
  46
  47 function MacroExpand(ast, env)
  48   let ast = a:ast
  49   while IsMacroCall(ast, a:env)
  50     let macroobj = a:env.get(ListFirst(ast).val)
  51     let macroargs = ListRest(ast)
  52     let ast = FuncInvoke(macroobj, macroargs)
  53   endwhile
  54   return ast
  55 endfunction
  56
  57 function EvalAst(ast, env)
  58   if SymbolQ(a:ast)
  59     let varname = a:ast.val
  60     return a:env.get(varname)
  61   elseif ListQ(a:ast)
  62     return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)}))
  63   elseif VectorQ(a:ast)
  64     return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)}))
  65   elseif HashQ(a:ast)
  66     let ret = {}
  67     for [k,v] in items(a:ast.val)
  68       let keyobj = HashParseKey(k)
  69       let newkey = EVAL(keyobj, a:env)
  70       let newval = EVAL(v, a:env)
  71       let keystring = HashMakeKey(newkey)
  72       let ret[keystring] = newval
  73     endfor
  74     return HashNew(ret)
  75   else
  76     return a:ast
  77   end
  78 endfunction
  79
  80 function GetCatchClause(ast)
  81   if ListCount(a:ast) < 3
  82     return ""
  83   end
  84   let catch_clause = ListNth(a:ast, 2)
  85   if ListFirst(catch_clause) == SymbolNew("catch*")
  86     return catch_clause
  87   else
  88     return ""
  89   end
  90 endfunction
  91
  92 function EVAL(ast, env)
  93   let ast = a:ast
  94   let env = a:env
  95
  96   while 1
  97     if !ListQ(ast)
  98       return EvalAst(ast, env)
  99     end
 100
 101     let ast = MacroExpand(ast, env)
 102     if !ListQ(ast)
 103       return EvalAst(ast, env)
 104     end
 105     if EmptyQ(ast)
 106       return ast
 107     endif
 108
 109     let first = ListFirst(ast)
 110     let first_symbol = SymbolQ(first) ? first.val : ""
 111     if first_symbol == "def!"
 112       let a1 = ast.val[1]
 113       let a2 = ast.val[2]
 114       return env.set(a1.val, EVAL(a2, env))
 115     elseif first_symbol == "let*"
 116       let a1 = ast.val[1]
 117       let a2 = ast.val[2]
 118       let env = NewEnv(env)
 119       let let_binds = a1.val
 120       let i = 0
 121       while i < len(let_binds)
 122         call env.set(let_binds[i].val, EVAL(let_binds[i+1], env))
 123         let i = i + 2
 124       endwhile
 125       let ast = a2
 126       " TCO
 127     elseif first_symbol == "quote"
 128       return ListNth(ast, 1)
 129     elseif first_symbol == "quasiquote"
 130       let ast = Quasiquote(ListNth(ast, 1))
 131       " TCO
 132     elseif first_symbol == "defmacro!"
 133       let a1 = ListNth(ast, 1)
 134       let a2 = ListNth(ast, 2)
 135       let macro = MarkAsMacro(EVAL(a2, env))
 136       return env.set(a1.val, macro)
 137     elseif first_symbol == "macroexpand"
 138       return MacroExpand(ListNth(ast, 1), env)
 139     elseif first_symbol == "if"
 140       let condvalue = EVAL(ast.val[1], env)
 141       if FalseQ(condvalue) || NilQ(condvalue)
 142         if len(ast.val) < 4
 143           return g:MalNil
 144         else
 145           let ast = ast.val[3]
 146         endif
 147       else
 148         let ast = ast.val[2]
 149       endif
 150       " TCO
 151     elseif first_symbol == "try*"
 152       try
 153         return EVAL(ListNth(ast, 1), env)
 154       catch
 155         let catch_clause = GetCatchClause(ast)
 156         if empty(catch_clause)
 157           throw v:exception
 158         endif
 159
 160         let exc_var = ListNth(catch_clause, 1).val
 161         if v:exception == "__MalException__"
 162           let exc_value = g:MalExceptionObj
 163         else
 164           let exc_value = StringNew(v:exception)
 165         endif
 166         let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value]))
 167         return EVAL(ListNth(catch_clause, 2), catch_env)
 168       endtry
 169     elseif first_symbol == "do"
 170       let astlist = ast.val
 171       call EvalAst(ListNew(astlist[1:-2]), env)
 172       let ast = astlist[-1]
 173       " TCO
 174     elseif first_symbol == "fn*"
 175       let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1))
 176       return fn
 177     elseif first_symbol == "eval"
 178       let ast = EVAL(ListNth(ast, 1), env)
 179       let env = env.root()
 180       " TCO
 181     else
 182       " apply list
 183       let el = EvalAst(ast, env)
 184       let funcobj = ListFirst(el)
 185       let args = ListRest(el)
 186       if NativeFunctionQ(funcobj)
 187         return NativeFuncInvoke(funcobj, args)
 188       elseif FunctionQ(funcobj)
 189         let fn = funcobj.val
 190         let ast = fn.ast
 191         let env = NewEnvWithBinds(fn.env, fn.params, args)
 192         " TCO
 193       else
 194         throw "Not a function"
 195       endif
 196     endif
 197   endwhile
 198 endfunction
 199
 200 function PRINT(exp)
 201   return PrStr(a:exp, 1)
 202 endfunction
 203
 204 function RE(str, env)
 205   return EVAL(READ(a:str), a:env)
 206 endfunction
 207
 208 function REP(str, env)
 209   return PRINT(EVAL(READ(a:str), a:env))
 210 endfunction
 211
 212 function GetArgvList()
 213   return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)}))
 214 endfunction
 215
 216 set maxfuncdepth=10000
 217 let repl_env = NewEnv("")
 218
 219 for [k, v] in items(CoreNs)
 220   call repl_env.set(k, v)
 221 endfor
 222
 223 call repl_env.set("*ARGV*", GetArgvList())
 224
 225 call RE("(def! *host-language* \"vimscript\")", repl_env)
 226 call RE("(def! not (fn* (a) (if a false true)))", repl_env)
 227 call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env)
 228 call 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)))))))", repl_env)
 229
 230 if !empty(argv())
 231   try
 232     call RE('(load-file "' . argv(0) . '")', repl_env)
 233   catch
 234     call PrintLn("Error: " . v:exception)
 235   endtry
 236   qall!
 237 endif
 238
 239 call REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env)
 240
 241 while 1
 242   let [eof, line] = Readline("user> ")
 243   if eof
 244     break
 245   endif
 246   if line == ""
 247     continue
 248   endif
 249   try
 250     call PrintLn(REP(line, repl_env))
 251   catch
 252     if v:exception == "__MalException__"
 253       call PrintLn("Error: " . PrStr(g:MalExceptionObj, 1))
 254     else
 255       call PrintLn("Error: " . v:exception)
 256     end
 257   endtry
 258 endwhile
 259 qall!