Step 7 of Make-a-Lisp for Erlang

step0 through step7 passes (sans step5 special case)

erlang/Makefile

@@ -1,14 +1,14 @@
 #####################
 
 SOURCES_BASE = src/step0_repl.erl src/step1_read_print.erl src/step2_eval.erl src/step3_env.erl \
-	src/step4_if_fn_do.erl src/step5_tco.erl src/step6_file.erl
+	src/step4_if_fn_do.erl src/step5_tco.erl src/step6_file.erl src/step7_quote.erl
 SOURCES_LISP = src/core.erl src/env.erl src/printer.erl src/reader.erl src/types.erl
 SOURCES = $(SOURCES_BASE) $(word $(words $(SOURCES_LISP)),${SOURCES_LISP})
 
 #####################
 
 SRCS = step0_repl.erl step1_read_print.erl step2_eval.erl step3_env.erl step4_if_fn_do.erl \
-	step5_tco.erl step6_file.erl
+	step5_tco.erl step6_file.erl step7_quote.erl
 BINS = $(SRCS:%.erl=%)
 
 #####################

erlang/rebar.config

@@ -16,5 +16,6 @@
     "step3_env",
     "step4_if_fn_do",
     "step5_tco",
-    "step6_file"
+    "step6_file",
+    "step7_quote"
 ]}.

erlang/src/core.erl

@@ -5,24 +5,21 @@
 -module(core).
 -compile(export_all).
 
-count([Args]) ->
-    case Args of
-        {list, List} -> {integer, length(List)};
-        {vector, List} -> {integer, length(List)};
-        nil -> {integer, 0};
-        _ -> {error, "count called on non-sequence"}
-    end;
+count([{Type, List}]) when Type == list orelse Type == vector ->
+    {integer, length(List)};
+count([nil]) ->
+    {integer, 0};
+count([_]) ->
+    {error, "count called on non-sequence"};
 count([]) ->
     {error, "count called with no arguments"};
 count(_) ->
     {error, "count expects one list argument"}.
 
-empty_q([Args]) ->
-    case Args of
-        {list, List} -> length(List) == 0;
-        {vector, List} -> length(List) == 0;
-        _ -> {error, "empty? called on non-sequence"}
-    end;
+empty_q([{Type, List}]) when Type == list orelse Type == vector ->
+    length(List) == 0;
+empty_q([_]) ->
+    {error, "empty? called on non-sequence"};
 empty_q([]) ->
     {error, "empty? called with no arguments"};
 empty_q(_) ->
@@ -129,6 +126,27 @@ slurp([{string, Filepath}]) ->
 slurp(_) ->
     {error, "slurp called with non-string"}.
 
+cons([Elem, {Type, List}]) when Type == list orelse Type == vector ->
+    {list, [Elem|List]};
+cons([_,_]) ->
+    {error, "second argument to cons must be a sequence"};
+cons(_) ->
+    {error, "cons expects two arguments"}.
+
+concat(Args) ->
+    PushAll = fun(Elem, AccIn) ->
+        case Elem of
+            {Type, List} when Type == list orelse Type == vector ->
+                AccIn ++ List;
+            _ -> throw("concat called with non-sequence")
+        end
+    end,
+    try lists:foldl(PushAll, [], Args) of
+        Result -> {list, Result}
+    catch
+        throw:Reason -> {error, Reason}
+    end.
+
 ns() ->
     Builtins = #{
         "*" => fun int_mul/1,
@@ -140,6 +158,8 @@ ns() ->
         "=" => fun equal_q/1,
         ">" => fun bool_gt/1,
         ">=" => fun bool_gte/1,
+        "concat" => fun concat/1,
+        "cons" => fun cons/1,
         "count" => fun count/1,
         "empty?" => fun empty_q/1,
         "list" => fun types:list/1,

erlang/src/reader.erl

@@ -93,8 +93,8 @@ read_seq_tail(Reader, CloseChar, CloseDelim, AccIn) ->
     end.
 
 % Convert a list of key/value pairs into a map. The elements are not
-% tuples; the keys are the even numbered members, and the values are the
-% odd numbered members. Fails if list has an odd number of members.
+% tuples; the keys are the odd numbered members, and the values are the
+% even numbered members. Fails if list has an odd number of members.
 list_to_map(L) ->
     list_to_map(L, #{}).
 

erlang/src/step7_quote.erl

@@ -0,0 +1,178 @@
+%%%
+%%% Step 7: Quoting
+%%%
+
+-module(step7_quote).
+
+-export([main/1]).
+
+main([File|Args]) ->
+    Env = init(),
+    env:set(Env, {symbol, "*ARGV*"}, {list, Args}),
+    rep("(load-file \"" ++ File ++ "\")", Env);
+main([]) ->
+    Env = init(),
+    env:set(Env, {symbol, "*ARGV*"}, {list, []}),
+    loop(Env).
+
+init() ->
+    Env = core:ns(),
+    % define the load-file and not functions using mal itself
+    eval(read("(def! not (fn* (a) (if a false true)))"), Env),
+    eval(read("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"), Env),
+    Env.
+
+loop(Env) ->
+    case io:get_line(standard_io, "user> ") of
+        eof -> io:format("~n");
+        {error, Reason} -> exit(Reason);
+        Line ->
+            rep(string:strip(Line, both, $\n), Env),
+            loop(Env)
+    end.
+
+rep(Input, Env) ->
+    try eval(read(Input), Env) of
+        Result -> print(Result)
+    catch
+        throw:Reason -> io:format("error: ~s~n", [Reason])
+    end.
+
+read(Input) ->
+    case reader:read_str(Input) of
+        {ok, Value} -> Value;
+        {error, Reason} -> throw(Reason)
+    end.
+
+eval({list, []}, _Env) ->
+    [];
+eval({list, [{symbol, "def!"}, {symbol, A1}, A2]}, Env) ->
+    Result = eval(A2, Env),
+    env:set(Env, {symbol, A1}, Result),
+    Result;
+eval({list, [{symbol, "def!"}, _A1, _A2]}, _Env) ->
+    throw("def! called with non-symbol");
+eval({list, [{symbol, "def!"}|_]}, _Env) ->
+    throw("def! requires exactly two arguments");
+eval({list, [{symbol, "let*"}, A1, A2]}, Env) ->
+    NewEnv = env:new(Env),
+    let_star(NewEnv, A1),
+    eval(A2, NewEnv);
+eval({list, [{symbol, "let*"}|_]}, _Env) ->
+    throw("let* requires exactly two arguments");
+eval({list, [{symbol, "do"}|Args]}, Env) ->
+    eval_ast({list, lists:droplast(Args)}, Env),
+    eval(lists:last(Args), Env);
+eval({list, [{symbol, "if"}, Test, Consequent|Alternate]}, Env) ->
+    case eval(Test, Env) of
+        Cond when Cond == false orelse Cond == nil ->
+            case Alternate of
+                []  -> nil;
+                [A] -> eval(A, Env);
+                _   -> throw("if takes 2 or 3 arguments")
+            end;
+        _ -> eval(Consequent, Env)
+    end;
+eval({list, [{symbol, "if"}|_]}, _Env) ->
+    throw("if requires test and consequent");
+eval({list, [{symbol, "fn*"}, {vector, Binds}, Body]}, Env) ->
+    {closure, Binds, Body, Env};
+eval({list, [{symbol, "fn*"}, {list, Binds}, Body]}, Env) ->
+    {closure, Binds, Body, Env};
+eval({list, [{symbol, "fn*"}|_]}, _Env) ->
+    throw("fn* requires 2 arguments");
+eval({list, [{symbol, "eval"}, AST]}, Env) ->
+    % Must use the root environment so the variables set within the parsed
+    % expression will be visible within the repl.
+    eval(eval(AST, Env), env:root(Env));
+eval({list, [{symbol, "eval"}|_]}, _Env) ->
+    throw("eval requires 1 argument");
+eval({list, [{symbol, "quote"}, AST]}, _Env) ->
+    AST;
+eval({list, [{symbol, "quote"}|_]}, _Env) ->
+    throw("quote requires 1 argument");
+eval({list, [{symbol, "quasiquote"}, AST]}, Env) ->
+    eval(quasiquote(AST), Env);
+eval({list, [{symbol, "quasiquote"}|_]}, _Env) ->
+    throw("quasiquote requires 1 argument");
+eval({list, List}, Env) ->
+    case eval_ast({list, List}, Env) of
+        {list, [{closure, Binds, Body, CE}|A]} ->
+            % The args may be a single element or a list, so always make it
+            % a list and then flatten it so it becomes a list.
+            NewEnv = env:new(CE),
+            env:bind(NewEnv, Binds, lists:flatten([A])),
+            eval(Body, NewEnv);
+        {list, [{function, F}|A]} -> erlang:apply(F, [A]);
+        {list, [{error, Reason}]} -> {error, Reason};
+        _ -> throw("expected a list")
+    end;
+eval(Value, Env) ->
+    eval_ast(Value, Env).
+
+eval_ast({symbol, _Sym}=Value, Env) ->
+    env:get(Env, Value);
+eval_ast({Type, Seq}, Env) when Type == list orelse Type == vector ->
+    {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq)};
+eval_ast({map, M}, Env) ->
+    {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M)};
+eval_ast(Value, _Env) ->
+    Value.
+
+print(none) ->
+    % if nothing meaningful was entered, print nothing at all
+    ok;
+print(Value) ->
+    io:format("~s~n", [printer:pr_str(Value, true)]).
+
+let_star(Env, Bindings) ->
+    Bind = fun({Name, Expr}) ->
+        case Name of
+            {symbol, _Sym} -> env:set(Env, Name, eval(Expr, Env));
+            _ -> throw("let* with non-symbol binding")
+        end
+    end,
+    case Bindings of
+        {Type, Binds} when Type == list orelse Type == vector ->
+            case list_to_proplist(Binds) of
+                {error, Reason} -> throw(Reason);
+                Props -> lists:foreach(Bind, Props)
+            end;
+        _ -> throw("let* with non-list bindings")
+    end.
+
+list_to_proplist(L) ->
+    list_to_proplist(L, []).
+
+list_to_proplist([], AccIn) ->
+    lists:reverse(AccIn);
+list_to_proplist([_H], _AccIn) ->
+    {error, "mismatch in let* name/value bindings"};
+list_to_proplist([K,V|T], AccIn) ->
+    list_to_proplist(T, [{K, V}|AccIn]).
+
+quasiquote({T, [{list, [{symbol, "splice-unquote"}, First]}|Rest]}) when T == list orelse T == vector ->
+    % 3. if is_pair of first element of ast is true and the first element of
+    %    first element of ast (ast[0][0]) is a symbol named "splice-unquote":
+    %    return a new list containing: a symbol named "concat", the second element
+    %    of first element of ast (ast[0][1]), and the result of calling quasiquote
+    %    with the second through last element of ast.
+    {list, [{symbol, "concat"}, First] ++ [quasiquote({list, Rest})]};
+quasiquote({T, [{symbol, "splice-unquote"}]}) when T == list orelse T == vector ->
+    {error, "splice-unquote requires an argument"};
+quasiquote({T, [{symbol, "unquote"}, AST]}) when T == list orelse T == vector ->
+    % 2. else if the first element of ast is a symbol named "unquote": return
+    %    the second element of ast.
+    AST;
+quasiquote({T, [{symbol, "unquote"}|_]}) when T == list orelse T == vector ->
+    {error, "unquote expects one argument"};
+quasiquote({T, [First|Rest]}) when T == list orelse T == vector ->
+    % 4. otherwise: return a new list containing: a symbol named "cons",
+    %    the result of calling quasiquote on first element of ast (ast[0]),
+    %    and result of calling quasiquote with the second through last
+    %    element of ast.
+    {list, [{symbol, "cons"}, quasiquote(First)] ++ [quasiquote({list, Rest})]};
+quasiquote(AST) ->
+    % 1. if is_pair of ast is false: return a new list containing:
+    %    a symbol named "quote" and ast.
+    {list, [{symbol, "quote"}, AST]}.