[jackhill/mal.git] / vimscript / stepA_mal.vim

source readline.vim
source types.vim
source reader.vim
source printer.vim
source env.vim
source core.vim

let MalExceptionObj = ""

function READ(str)
  return ReadStr(a:str)
endfunction

function PairQ(obj)
  return SequentialQ(a:obj) && !EmptyQ(a:obj)
endfunction

function Quasiquote(ast)
  if !PairQ(a:ast)
    return ListNew([SymbolNew("quote"), a:ast])
  endif
  let a0 = ListFirst(a:ast)
  if SymbolQ(a0) && a0.val == "unquote"
    return ListNth(a:ast, 1)
  elseif PairQ(a0) && SymbolQ(ListFirst(a0)) && ListFirst(a0).val == "splice-unquote"
    return ListNew([SymbolNew("concat"), ListNth(a0, 1), Quasiquote(ListRest(a:ast))])
  else
    return ListNew([SymbolNew("cons"), Quasiquote(a0), Quasiquote(ListRest(a:ast))])
  end
endfunction

function IsMacroCall(ast, env)
  if !ListQ(a:ast)
    return 0
  endif
  let a0 = ListFirst(a:ast)
  if !SymbolQ(a0)
    return 0
  endif
  let macroname = a0.val
  if empty(a:env.find(macroname))
    return 0
  endif
  return MacroQ(a:env.get(macroname))
endfunction

function MacroExpand(ast, env)
  let ast = a:ast
  while IsMacroCall(ast, a:env)
    let macroobj = a:env.get(ListFirst(ast).val)
    let macroargs = ListRest(ast)
    let ast = FuncInvoke(macroobj, macroargs)
  endwhile
  return ast
endfunction

function EvalAst(ast, env)
  if SymbolQ(a:ast)
    let varname = a:ast.val
    return a:env.get(varname)
  elseif ListQ(a:ast)
    let ret = []
    for e in a:ast.val
      call add(ret, EVAL(e, a:env))
    endfor
    return ListNew(ret)
  elseif VectorQ(a:ast)
    let ret = []
    for e in a:ast.val
      call add(ret, EVAL(e, a:env))
    endfor
    return VectorNew(ret)
  elseif HashQ(a:ast)
    let ret = {}
    for [k,v] in items(a:ast.val)
      let keyobj = HashParseKey(k)
      let newkey = EVAL(keyobj, a:env)
      let newval = EVAL(v, a:env)
      let keystring = HashMakeKey(newkey)
      let ret[keystring] = newval
    endfor
    return HashNew(ret)
  else
    return a:ast
  end
endfunction

function GetCatchClause(ast)
  if ListCount(a:ast) < 3
    return ""
  end
  let catch_clause = ListNth(a:ast, 2)
  if ListFirst(catch_clause) == SymbolNew("catch*")
    return catch_clause
  else
    return ""
  end
endfunction

function EVAL(ast, env)
  let ast = a:ast
  let env = a:env

  while 1
    if !ListQ(ast)
      return EvalAst(ast, env)
    end

    let ast = MacroExpand(ast, env)
    if !ListQ(ast)
      return EvalAst(ast, env)
    end
    if EmptyQ(ast)
      return ast
    endif

    let first = ListFirst(ast)
    let first_symbol = SymbolQ(first) ? first.val : ""
    if first_symbol == "def!"
      let a1 = ast.val[1]
      let a2 = ast.val[2]
      return env.set(a1.val, EVAL(a2, env))
    elseif first_symbol == "let*"
      let a1 = ast.val[1]
      let a2 = ast.val[2]
      let env = NewEnv(env)
      let let_binds = a1.val
      let i = 0
      while i < len(let_binds)
        call env.set(let_binds[i].val, EVAL(let_binds[i+1], env))
        let i = i + 2
      endwhile
      let ast = a2
      " TCO
    elseif first_symbol == "quote"
      return ListNth(ast, 1)
    elseif first_symbol == "quasiquote"
      let ast = Quasiquote(ListNth(ast, 1))
      " TCO
    elseif first_symbol == "defmacro!"
      let a1 = ListNth(ast, 1)
      let a2 = ListNth(ast, 2)
      let macro = MarkAsMacro(EVAL(a2, env))
      return env.set(a1.val, macro)
    elseif first_symbol == "macroexpand"
      return MacroExpand(ListNth(ast, 1), env)
    elseif first_symbol == "if"
      let condvalue = EVAL(ast.val[1], env)
      if FalseQ(condvalue) || NilQ(condvalue)
        if len(ast.val) < 4
          return g:MalNil
        else
          let ast = ast.val[3]
        endif
      else
        let ast = ast.val[2]
      endif
      " TCO
    elseif first_symbol == "try*"
      try
        return EVAL(ListNth(ast, 1), env)
      catch
        let catch_clause = GetCatchClause(ast)
        if empty(catch_clause)
          throw v:exception
        endif

        let exc_var = ListNth(catch_clause, 1).val
        if v:exception == "__MalException__"
          let exc_value = g:MalExceptionObj
        else
          let exc_value = StringNew(v:exception)
        endif
        let catch_env = NewEnvWithBinds(env, ListNew([SymbolNew(exc_var)]), ListNew([exc_value]))
        return EVAL(ListNth(catch_clause, 2), catch_env)
      endtry
    elseif first_symbol == "do"
      let astlist = ast.val
      call EvalAst(ListNew(astlist[1:-2]), env)
      let ast = astlist[-1]
      " TCO
    elseif first_symbol == "fn*"
      let fn = NewFn(ListNth(ast, 2), env, ListNth(ast, 1))
      return fn
    elseif first_symbol == "eval"
      let ast = EVAL(ListNth(ast, 1), env)
      let env = env.root()
      " TCO
    else
      " apply list
      let el = EvalAst(ast, env)
      let funcobj = ListFirst(el)
      let args = ListRest(el)
      if NativeFunctionQ(funcobj)
        return NativeFuncInvoke(funcobj, args)
      elseif FunctionQ(funcobj)
        let fn = funcobj.val
        let ast = fn.ast
        let env = NewEnvWithBinds(fn.env, fn.params, args)
        " TCO
      else
        throw "Not a function"
      endif
    endif
  endwhile
endfunction

function PRINT(exp)
  return PrStr(a:exp, 1)
endfunction

function RE(str, env)
  return EVAL(READ(a:str), a:env)
endfunction

function REP(str, env)
  return PRINT(EVAL(READ(a:str), a:env))
endfunction

function GetArgvList()
  return ListNew(map(copy(argv()[1:]), {_, arg -> StringNew(arg)}))
endfunction

set maxfuncdepth=10000
let repl_env = NewEnv("")

for [k, v] in items(CoreNs)
  call repl_env.set(k, v)
endfor

call repl_env.set("*ARGV*", GetArgvList())

call RE("(def! *host-language* \"vimscript\")", repl_env)
call RE("(def! not (fn* (a) (if a false true)))", repl_env)
call RE("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))", repl_env)
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)
call RE("(def! *gensym-counter* (atom 0))", repl_env)
call RE("(def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))", repl_env)
call 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)))))))))", repl_env)

if !empty(argv())
  try
    call RE('(load-file "' . argv(0) . '")', repl_env)
  catch
    call PrintLn("Error: " . v:exception)
  endtry
  qall!
endif

call REP("(println (str \"Mal [\" *host-language* \"]\"))", repl_env)

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