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, "quasiquote"}, AST], _Meta}, Env) ->
 113     eval(quasiquote(AST), Env);
 114 eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) ->
 115     error("quasiquote requires 1 argument");
 116 eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2], _Meta}, Env) ->
 117     case eval(A2, Env) of
 118         {closure, _Eval, Binds, Body, CE, _MC} ->
 119             Result = {macro, Binds, Body, CE},
 120             env:set(Env, {symbol, A1}, Result),
 121             Result;
 122         Result -> env:set(Env, {symbol, A1}, Result), Result
 123     end,
 124     Result;
 125 eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) ->
 126     error("defmacro! called with non-symbol");
 127 eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) ->
 128     error("defmacro! requires exactly two arguments");
 129 eval_list({list, [{symbol, "macroexpand"}, Macro], _Meta}, Env) ->
 130     macroexpand(Macro, Env);
 131 eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) ->
 132     error("macroexpand requires 1 argument");
 133 eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) ->
 134     try eval(A, Env) of
 135         Result -> Result
 136     catch
 137         error:Reason ->
 138             NewEnv = env:new(Env),
 139             env:bind(NewEnv, [B], [{string, Reason}]),
 140             eval(C, NewEnv);
 141         throw:Reason ->
 142             NewEnv = env:new(Env),
 143             env:bind(NewEnv, [B], [Reason]),
 144             eval(C, NewEnv)
 145     end;
 146 eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) ->
 147     eval(AST, Env);
 148 eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) ->
 149     error("try*/catch* must be of the form (try* A (catch* B C))");
 150 eval_list({list, List, Meta}, Env) ->
 151     case eval_ast({list, List, Meta}, Env) of
 152         {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} ->
 153             % The args may be a single element or a list, so always make it
 154             % a list and then flatten it so it becomes a list.
 155             NewEnv = env:new(CE),
 156             env:bind(NewEnv, Binds, lists:flatten([A])),
 157             eval(Body, NewEnv);
 158         {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]);
 159         {list, [{error, Reason}], _M4} -> {error, Reason};
 160         _ -> error("expected a list")
 161     end.
 162
 163 eval_ast({symbol, _Sym}=Value, Env) ->
 164     env:get(Env, Value);
 165 eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector ->
 166     {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil};
 167 eval_ast({map, M, _Meta}, Env) ->
 168     {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil};
 169 eval_ast(Value, _Env) ->
 170     Value.
 171
 172 print(none) ->
 173     % if nothing meaningful was entered, print nothing at all
 174     ok;
 175 print(Value) ->
 176     io:format("~s~n", [Value]).
 177
 178 let_star(Env, Bindings) ->
 179     Bind = fun({Name, Expr}) ->
 180         case Name of
 181             {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env));
 182             _ -> error("let* with non-symbol binding")
 183         end
 184     end,
 185     case Bindings of
 186         {Type, Binds, _Meta} when Type == list orelse Type == vector ->
 187             case list_to_proplist(Binds) of
 188                 {error, Reason} -> error(Reason);
 189                 Props -> lists:foreach(Bind, Props)
 190             end;
 191         _ -> error("let* with non-list bindings")
 192     end.
 193
 194 list_to_proplist(L) ->
 195     list_to_proplist(L, []).
 196
 197 list_to_proplist([], AccIn) ->
 198     lists:reverse(AccIn);
 199 list_to_proplist([_H], _AccIn) ->
 200     {error, "mismatch in let* name/value bindings"};
 201 list_to_proplist([K,V|T], AccIn) ->
 202     list_to_proplist(T, [{K, V}|AccIn]).
 203
 204 quasiquote({T, [{list, [{symbol, "splice-unquote"}, First], _M1}|Rest], _M2}) when T == list orelse T == vector ->
 205     % 3. if is_pair of first element of ast is true and the first element of
 206     %    first element of ast (ast[0][0]) is a symbol named "splice-unquote":
 207     %    return a new list containing: a symbol named "concat", the second element
 208     %    of first element of ast (ast[0][1]), and the result of calling quasiquote
 209     %    with the second through last element of ast.
 210     {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest, nil})], nil};
 211 quasiquote({T, [{symbol, "splice-unquote"}], _M}) when T == list orelse T == vector ->
 212     {error, "splice-unquote requires an argument"};
 213 quasiquote({T, [{symbol, "unquote"}, AST], _M}) when T == list orelse T == vector ->
 214     % 2. else if the first element of ast is a symbol named "unquote": return
 215     %    the second element of ast.
 216     AST;
 217 quasiquote({T, [{symbol, "unquote"}|_], _M}) when T == list orelse T == vector ->
 218     {error, "unquote expects one argument"};
 219 quasiquote({T, [First|Rest], _M}) when T == list orelse T == vector ->
 220     % 4. otherwise: return a new list containing: a symbol named "cons",
 221     %    the result of calling quasiquote on first element of ast (ast[0]),
 222     %    and result of calling quasiquote with the second through last
 223     %    element of ast.
 224     {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest, nil})], nil};
 225 quasiquote(AST) ->
 226     % 1. if is_pair of ast is false: return a new list containing:
 227     %    a symbol named "quote" and ast.
 228     {list, [{symbol, "quote"}, AST], nil}.
 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.