impls/erlang/src/stepA_mal.erl

   1 %%%
   2 %%% Step A: Mutation, Self-hosting and Interop
   3 %%%
   4
   5 -module(stepA_mal).
   6
   7 -export([main/1]).
   8
   9 main([File|Args]) ->
  10     Env = init(),
  11     env:set(Env, {symbol, "*ARGV*"}, {list, [{string,Arg} || Arg <- Args], nil}),
  12     rep("(load-file \"" ++ File ++ "\")", Env);
  13 main([]) ->
  14     Env = init(),
  15     env:set(Env, {symbol, "*ARGV*"}, {list, [], nil}),
  16     eval(read("(println (str \"Mal [\" *host-language* \"]\"))"), Env),
  17     loop(Env).
  18
  19 init() ->
  20     Env = core:ns(),
  21     eval(read("(def! *host-language* \"Erlang\")"), Env),
  22     eval(read("(def! not (fn* (a) (if a false true)))"), Env),
  23     eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"), Env),
  24     eval(read("(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)))))))"), Env),
  25     Env.
  26
  27 loop(Env) ->
  28     case io:get_line(standard_io, "user> ") of
  29         eof -> io:format("~n");
  30         {error, Reason} -> exit(Reason);
  31         Line ->
  32             print(rep(string:strip(Line, both, $\n), Env)),
  33             loop(Env)
  34     end.
  35
  36 rep(Input, Env) ->
  37     try eval(read(Input), Env) of
  38         none -> none;
  39         Result -> printer:pr_str(Result, true)
  40     catch
  41         error:Reason -> printer:pr_str({error, Reason}, true);
  42         throw:Reason -> printer:pr_str({error, printer:pr_str(Reason, true)}, true)
  43     end.
  44
  45 read(Input) ->
  46     case reader:read_str(Input) of
  47         {ok, Value} -> Value;
  48         {error, Reason} -> error(Reason)
  49     end.
  50
  51 eval(Value, Env) ->
  52     case Value of
  53         {list, _L1, _M1} ->
  54             case macroexpand(Value, Env) of
  55                 {list, _L2, _M2} = List -> eval_list(List, Env);
  56                 AST -> eval_ast(AST, Env)
  57             end;
  58         _ -> eval_ast(Value, Env)
  59     end.
  60
  61 eval_list({list, [], _Meta}=AST, _Env) ->
  62     AST;
  63 eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) ->
  64     Result = eval(A2, Env),
  65     case Result of
  66         {error, _R1} -> Result;
  67         _ ->
  68             env:set(Env, {symbol, A1}, Result),
  69             Result
  70     end;
  71 eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) ->
  72     error("def! called with non-symbol");
  73 eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) ->
  74     error("def! requires exactly two arguments");
  75 eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) ->
  76     NewEnv = env:new(Env),
  77     let_star(NewEnv, A1),
  78     eval(A2, NewEnv);
  79 eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) ->
  80     error("let* requires exactly two arguments");
  81 eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) ->
  82     eval_ast({list, lists:droplast(Args), nil}, Env),
  83     eval(lists:last(Args), Env);
  84 eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) ->
  85     case eval(Test, Env) of
  86         Cond when Cond == false orelse Cond == nil ->
  87             case Alternate of
  88                 []  -> nil;
  89                 [A] -> eval(A, Env);
  90                 _   -> error("if takes 2 or 3 arguments")
  91             end;
  92         _ -> eval(Consequent, Env)
  93     end;
  94 eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) ->
  95     error("if requires test and consequent");
  96 eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) ->
  97     {closure, fun eval/2, Binds, Body, Env, nil};
  98 eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) ->
  99     {closure, fun eval/2, Binds, Body, Env, nil};
 100 eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) ->
 101     error("fn* requires 2 arguments");
 102 eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) ->
 103     % Must use the root environment so the variables set within the parsed
 104     % expression will be visible within the repl.
 105     eval(eval(AST, Env), env:root(Env));
 106 eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) ->
 107     error("eval requires 1 argument");
 108 eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) ->
 109     AST;
 110 eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) ->
 111     error("quote requires 1 argument");
 112 eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) ->
 113     quasiquote(AST);
 114 eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) ->
 115     error("quasiquoteexpand requires 1 argument");
 116 eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) ->
 117     eval(quasiquote(AST), Env);
 118 eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) ->
 119     error("quasiquote requires 1 argument");
 120 eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) ->
 121     case eval(A2, Env) of
 122         {closure, _Eval, Binds, Body, CE, _MC} ->
 123             Result = {macro, Binds, Body, CE},
 124             env:set(Env, {symbol, A1}, Result),
 125             Result;
 126         Result -> env:set(Env, {symbol, A1}, Result), Result
 127     end,
 128     Result;
 129 eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) ->
 130     error("defmacro! called with non-symbol");
 131 eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) ->
 132     error("defmacro! requires exactly two arguments");
 133 eval_list({list, [{symbol, "macroexpand"}, Macro], _Meta}, Env) ->
 134     macroexpand(Macro, Env);
 135 eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) ->
 136     error("macroexpand requires 1 argument");
 137 eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) ->
 138     try eval(A, Env) of
 139         Result -> Result
 140     catch
 141         error:Reason ->
 142             NewEnv = env:new(Env),
 143             env:bind(NewEnv, [B], [{string, Reason}]),
 144             eval(C, NewEnv);
 145         throw:Reason ->
 146             NewEnv = env:new(Env),
 147             env:bind(NewEnv, [B], [Reason]),
 148             eval(C, NewEnv)
 149     end;
 150 eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) ->
 151     eval(AST, Env);
 152 eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) ->
 153     error("try*/catch* must be of the form (try* A (catch* B C))");
 154 eval_list({list, List, Meta}, Env) ->
 155     case eval_ast({list, List, Meta}, Env) of
 156         {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} ->
 157             % The args may be a single element or a list, so always make it
 158             % a list and then flatten it so it becomes a list.
 159             NewEnv = env:new(CE),
 160             env:bind(NewEnv, Binds, lists:flatten([A])),
 161             eval(Body, NewEnv);
 162         {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]);
 163         {list, [{error, Reason}], _M4} -> {error, Reason};
 164         _ -> error("expected a list")
 165     end.
 166
 167 eval_ast({symbol, _Sym}=Value, Env) ->
 168     env:get(Env, Value);
 169 eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector ->
 170     {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil};
 171 eval_ast({map, M, _Meta}, Env) ->
 172     {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil};
 173 eval_ast(Value, _Env) ->
 174     Value.
 175
 176 print(none) ->
 177     % if nothing meaningful was entered, print nothing at all
 178     ok;
 179 print(Value) ->
 180     io:format("~s~n", [Value]).
 181
 182 let_star(Env, Bindings) ->
 183     Bind = fun({Name, Expr}) ->
 184         case Name of
 185             {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env));
 186             _ -> error("let* with non-symbol binding")
 187         end
 188     end,
 189     case Bindings of
 190         {Type, Binds, _Meta} when Type == list orelse Type == vector ->
 191             case list_to_proplist(Binds) of
 192                 {error, Reason} -> error(Reason);
 193                 Props -> lists:foreach(Bind, Props)
 194             end;
 195         _ -> error("let* with non-list bindings")
 196     end.
 197
 198 list_to_proplist(L) ->
 199     list_to_proplist(L, []).
 200
 201 list_to_proplist([], AccIn) ->
 202     lists:reverse(AccIn);
 203 list_to_proplist([_H], _AccIn) ->
 204     {error, "mismatch in let* name/value bindings"};
 205 list_to_proplist([K,V|T], AccIn) ->
 206     list_to_proplist(T, [{K, V}|AccIn]).
 207
 208 qqLoop ({list, [{symbol, "splice-unquote"}, Arg], _Meta}, Acc) ->
 209     {list, [{symbol, "concat"}, Arg, Acc], nil};
 210 qqLoop({list, [{symbol, "splice-unquote"}|_], _Meta}, _Acc) ->
 211     {error, "splice-unquote requires an argument"};
 212 qqLoop(Elt, Acc) ->
 213     {list, [{symbol, "cons"}, quasiquote(Elt), Acc], nil}.
 214
 215 quasiquote({list, [{symbol, "unquote"}, Arg], _Meta}) ->
 216     Arg;
 217 quasiquote({list, [{symbol, "unquote"}|_], _Meta}) ->
 218     error("unquote requires 1 argument");
 219 quasiquote({list, List, _Meta}) ->
 220     lists:foldr(fun qqLoop/2, {list, [], nil}, List);
 221 quasiquote({vector, List, _Meta}) ->
 222     {list, [{symbol, "vec"}, lists:foldr(fun qqLoop/2, {list, [], nil}, List)], nil};
 223 quasiquote({symbol, _Symbol} = Arg) ->
 224     {list, [{symbol, "quote"}, Arg], nil};
 225 quasiquote({map, _Map, _Meta} = Arg) ->
 226     {list, [{symbol, "quote"}, Arg], nil};
 227 quasiquote(Arg) ->
 228     Arg.
 229
 230 is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) ->
 231     case env:find(Env, {symbol, Name}) of
 232         nil -> false;
 233         Env2 ->
 234             case env:get(Env2, {symbol, Name}) of
 235                 {macro, _Binds, _Body, _ME} -> true;
 236                 _ -> false
 237             end
 238     end;
 239 is_macro_call(_AST, _Env) ->
 240     false.
 241
 242 macroexpand(AST, Env) ->
 243     case is_macro_call(AST, Env) of
 244         true ->
 245             {list, [Name|A], _Meta} = AST,
 246             {macro, Binds, Body, ME} = env:get(Env, Name),
 247             NewEnv = env:new(ME),
 248             env:bind(NewEnv, Binds, lists:flatten([A])),
 249             NewAST = eval(Body, NewEnv),
 250             macroexpand(NewAST, Env);
 251         false -> AST
 252     end.