impls/vimscript/step7_quote.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 function READ(str)
   9   return ReadStr(a:str)
  10 endfunction
  11
  12 function StartsWith(ast, sym)
  13   if EmptyQ(a:ast)
  14      return 0
  15   endif
  16   let fst = ListFirst(a:ast)
  17   return SymbolQ(fst) && fst.val == a:sym
  18 endfunction
  19
  20 function QuasiquoteLoop(xs)
  21   let revlist = reverse(copy(a:xs))
  22   let acc = ListNew([])
  23   for elt in revlist
  24      if ListQ(elt) && StartsWith(elt, "splice-unquote")
  25        let acc = ListNew([SymbolNew("concat"), ListNth(elt, 1), acc])
  26      else
  27        let acc = ListNew([SymbolNew("cons"), Quasiquote(elt), acc])
  28      endif
  29    endfor
  30    return acc
  31  endfunction
  32
  33 function Quasiquote(ast)
  34   if VectorQ(a:ast)
  35     return ListNew([SymbolNew("vec"), QuasiquoteLoop(a:ast.val)])
  36   elseif SymbolQ(a:ast) || HashQ(a:ast)
  37     return ListNew([SymbolNew("quote"), a:ast])
  38   elseif !ListQ(a:ast)
  39     return a:ast
  40   elseif StartsWith(a:ast, "unquote")
  41     return ListNth(a:ast, 1)
  42   else
  43     return QuasiquoteLoop(a:ast.val)
  44   endif
  45 endfunction
  46
  47 function EvalAst(ast, env)
  48   if SymbolQ(a:ast)
  49     let varname = a:ast.val
  50     return a:env.get(varname)
  51   elseif ListQ(a:ast)
  52     return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)}))
  53   elseif VectorQ(a:ast)
  54     return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)}))
  55   elseif HashQ(a:ast)
  56     let ret = {}
  57     for [k,v] in items(a:ast.val)
  58       let keyobj = HashParseKey(k)
  59       let newkey = EVAL(keyobj, a:env)
  60       let newval = EVAL(v, a:env)
  61       let keystring = HashMakeKey(newkey)
  62       let ret[keystring] = newval
  63     endfor
  64     return HashNew(ret)
  65   else
  66     return a:ast
  67   end
  68 endfunction
  69
  70 function EVAL(ast, env)
  71   let ast = a:ast
  72   let env = a:env
  73
  74   while 1
  75     if !ListQ(ast)
  76       return EvalAst(ast, env)
  77     end
  78     if EmptyQ(ast)
  79       return ast
  80     endif
  81
  82     let first = ListFirst(ast)
  83     let first_symbol = SymbolQ(first) ? first.val : ""
  84     if first_symbol == "def!"
  85       let a1 = ast.val[1]
  86       let a2 = ast.val[2]
  87       let ret = env.set(a1.val, EVAL(a2, env))
  88       return ret
  89     elseif first_symbol == "let*"
  90       let a1 = ast.val[1]
  91       let a2 = ast.val[2]
  92       let env = NewEnv(env)
  93       let let_binds = a1.val
  94       let i = 0
  95       while i < len(let_binds)
  96         call env.set(let_binds[i].val, EVAL(let_binds[i+1], env))
  97         let i = i + 2
  98       endwhile
  99       let ast = a2
 100       " TCO
 101     elseif first_symbol == "quote"
 102       return ListNth(ast, 1)
 103     elseif first_symbol == "quasiquoteexpand"
 104       return Quasiquote(ListNth(ast, 1))
 105     elseif first_symbol == "quasiquote"
 106       let ast = Quasiquote(ListNth(ast, 1))
 107       " TCO
 108     elseif first_symbol == "if"
 109       let condvalue = EVAL(ast.val[1], env)
 110       if FalseQ(condvalue) || NilQ(condvalue)
 111         if len(ast.val) < 4
 112           return g:MalNil
 113         else
 114           let ast = ast.val[3]
 115         endif
 116       else
 117         let ast = ast.val[2]
 118       endif
 119       " TCO
 120     elseif first_symbol == "do"
 121       let astlist = ast.val
 122       call EvalAst(ListNew(astlist[1:-2]), env)
 123       let ast = astlist[-1]
 124       " TCO
 125     elseif first_symbol == "fn*"
 126       let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1))
 127       return fn
 128     elseif first_symbol == "eval"
 129       let ast = EVAL(ListNth(ast, 1), env)
 130       let env = env.root()
 131       " TCO
 132     else
 133       " apply list
 134       let el = EvalAst(ast, env)
 135       let funcobj = ListFirst(el)
 136       let args = ListRest(el)
 137       if NativeFunctionQ(funcobj)
 138         return NativeFuncInvoke(funcobj, args)
 139       elseif FunctionQ(funcobj)
 140         let fn = funcobj.val
 141         let ast = fn.ast
 142         let env = NewEnvWithBinds(fn.env, fn.params, args)
 143         " TCO
 144       else
 145         throw "Not a function"
 146       endif
 147     endif
 148   endwhile
 149 endfunction
 150
 151 function PRINT(exp)
 152   return PrStr(a:exp, 1)
 153 endfunction
 154
 155 function RE(str, env)
 156   return EVAL(READ(a:str), a:env)
 157 endfunction
 158
 159 function REP(str, env)
 160   return PRINT(EVAL(READ(a:str), a:env))
 161 endfunction
 162
 163 function GetArgvList()
 164   return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)}))
 165 endfunction
 166
 167 set maxfuncdepth=10000
 168 let repl_env = NewEnv("")
 169
 170 for [k, v] in items(CoreNs)
 171   call repl_env.set(k, v)
 172 endfor
 173
 174 call repl_env.set("*ARGV*", GetArgvList())
 175
 176 call RE("(def! not (fn* (a) (if a false true)))", repl_env)
 177 call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", repl_env)
 178
 179 if !empty(argv())
 180   call RE('(load-file "' . argv(0) . '")', repl_env)
 181   qall!
 182 endif
 183
 184 while 1
 185   let [eof, line] = Readline("user> ")
 186   if eof
 187     break
 188   endif
 189   if line == ""
 190     continue
 191   endif
 192   try
 193     call PrintLn(REP(line, repl_env))
 194   catch
 195     call PrintLn("Error: " . v:exception)
 196   endtry
 197 endwhile
 198 qall!