mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 01:57:09 +03:00
Step 8 of Make-a-Lisp for Erlang
step0 through step8 passes (sans step5 special case)
This commit is contained in:
parent
9d34827891
commit
a22d9443fb
@ -1,14 +1,15 @@
|
||||
#####################
|
||||
|
||||
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/step7_quote.erl
|
||||
src/step4_if_fn_do.erl src/step5_tco.erl src/step6_file.erl src/step7_quote.erl \
|
||||
src/step8_macros.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 step7_quote.erl
|
||||
step5_tco.erl step6_file.erl step7_quote.erl step8_macros.erl
|
||||
BINS = $(SRCS:%.erl=%)
|
||||
|
||||
#####################
|
||||
|
@ -17,5 +17,6 @@
|
||||
"step4_if_fn_do",
|
||||
"step5_tco",
|
||||
"step6_file",
|
||||
"step7_quote"
|
||||
"step7_quote",
|
||||
"step8_macros"
|
||||
]}.
|
||||
|
@ -25,6 +25,39 @@ empty_q([]) ->
|
||||
empty_q(_) ->
|
||||
{error, "empty? expects one list argument"}.
|
||||
|
||||
nth([{Type, List}, {integer, Index}]) when Type == list orelse Type == vector ->
|
||||
try lists:nth(Index+1, List) of
|
||||
Result -> Result
|
||||
catch
|
||||
error:_Error -> {error, "nth: index out of range"}
|
||||
end;
|
||||
nth([_]) ->
|
||||
{error, "nth expects two arguments"}.
|
||||
|
||||
first([{Type, [First|_Rest]}]) when Type == list orelse Type == vector ->
|
||||
First;
|
||||
first([{Type, []}]) when Type == list orelse Type == vector ->
|
||||
nil;
|
||||
first([nil]) ->
|
||||
nil;
|
||||
first([_]) ->
|
||||
{error, "first called on non-sequence"};
|
||||
first([]) ->
|
||||
{error, "first called with no arguments"};
|
||||
first(_) ->
|
||||
{error, "first expects one list argument"}.
|
||||
|
||||
rest([{Type, [_First|Rest]}]) when Type == list orelse Type == vector ->
|
||||
{list, Rest};
|
||||
rest([{Type, []}]) when Type == list orelse Type == vector ->
|
||||
{list, []};
|
||||
rest([_]) ->
|
||||
{error, "rest called on non-sequence"};
|
||||
rest([]) ->
|
||||
{error, "rest called with no arguments"};
|
||||
rest(_) ->
|
||||
{error, "rest expects one list argument"}.
|
||||
|
||||
equal_q(Args) ->
|
||||
case Args of
|
||||
[nil, nil] -> true;
|
||||
@ -162,12 +195,15 @@ ns() ->
|
||||
"cons" => fun cons/1,
|
||||
"count" => fun count/1,
|
||||
"empty?" => fun empty_q/1,
|
||||
"first" => fun first/1,
|
||||
"list" => fun types:list/1,
|
||||
"list?" => fun types:list_p/1,
|
||||
"nth" => fun nth/1,
|
||||
"pr-str" => fun pr_str/1,
|
||||
"println" => fun println/1,
|
||||
"prn" => fun prn/1,
|
||||
"read-string" => fun read_string/1,
|
||||
"rest" => fun rest/1,
|
||||
"slurp" => fun slurp/1,
|
||||
"str" => fun str/1
|
||||
},
|
||||
|
@ -10,7 +10,7 @@
|
||||
-module(env).
|
||||
-behavior(gen_server).
|
||||
|
||||
-export([new/1, bind/3, get/2, set/3, root/1]).
|
||||
-export([new/1, bind/3, find/2, get/2, set/3, root/1]).
|
||||
-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]).
|
||||
|
||||
-record(state, {outer, data}).
|
||||
@ -36,9 +36,16 @@ new(Outer) ->
|
||||
bind(Pid, Names, Values) ->
|
||||
gen_server:call(Pid, {bind, Names, Values}).
|
||||
|
||||
-spec find(Pid1, Key) -> Pid2
|
||||
when Pid1 :: pid(),
|
||||
Key :: {symbol, string()},
|
||||
Pid2 :: pid() | nil.
|
||||
find(Pid, {symbol, Name}) ->
|
||||
gen_server:call(Pid, {find_pid, Name}).
|
||||
|
||||
-spec get(Pid, Key) -> Value
|
||||
when Pid :: pid(),
|
||||
Key :: {symbol, term()},
|
||||
Key :: {symbol, string()},
|
||||
Value :: term().
|
||||
get(Pid, {symbol, Name}) ->
|
||||
case gen_server:call(Pid, {get, Name}) of
|
||||
@ -50,7 +57,7 @@ get(_Pid, _Key) ->
|
||||
|
||||
-spec set(Pid, Key, Value) -> ok
|
||||
when Pid :: pid(),
|
||||
Key :: {symbol, term()},
|
||||
Key :: {symbol, string()},
|
||||
Value :: term().
|
||||
set(Pid, {symbol, Name}, Value) ->
|
||||
gen_server:call(Pid, {set, Name, Value});
|
||||
@ -75,8 +82,10 @@ init([Outer]) ->
|
||||
handle_call({bind, Names, Values}, _From, State) ->
|
||||
NewEnv = env_bind(State, Names, Values),
|
||||
{reply, ok, NewEnv};
|
||||
handle_call({find, Name}, _From, State) ->
|
||||
handle_call({find_env, Name}, _From, State) ->
|
||||
{reply, env_find(State, Name), State};
|
||||
handle_call({find_pid, Name}, _From, State) ->
|
||||
{reply, pid_find(State, Name), State};
|
||||
handle_call({get, Name}, _From, State) ->
|
||||
{reply, env_get(State, Name), State};
|
||||
handle_call({set, Name, Value}, _From, State) ->
|
||||
@ -103,13 +112,23 @@ code_change(_OldVsn, State, _Extra) ->
|
||||
%% Internal functions
|
||||
%%
|
||||
|
||||
pid_find(Env, Name) ->
|
||||
case maps:is_key(Name, Env#state.data) of
|
||||
true -> self();
|
||||
false ->
|
||||
case Env#state.outer of
|
||||
undefined -> nil;
|
||||
Outer -> gen_server:call(Outer, {find_pid, Name})
|
||||
end
|
||||
end.
|
||||
|
||||
env_find(Env, Name) ->
|
||||
case maps:is_key(Name, Env#state.data) of
|
||||
true -> Env;
|
||||
false ->
|
||||
case Env#state.outer of
|
||||
undefined -> nil;
|
||||
Outer -> gen_server:call(Outer, {find, Name})
|
||||
Outer -> gen_server:call(Outer, {find_env, Name})
|
||||
end
|
||||
end.
|
||||
|
||||
@ -127,7 +146,7 @@ env_bind(Env, [{symbol, Name}|Ntail], [Value|Vtail]) ->
|
||||
|
||||
-spec env_get(Env, Key) -> {ok, Value} | {error, string()}
|
||||
when Env :: #state{},
|
||||
Key :: {symbol, term()},
|
||||
Key :: {symbol, string()},
|
||||
Value :: term().
|
||||
env_get(Env, Name) ->
|
||||
case env_find(Env, Name) of
|
||||
@ -137,7 +156,7 @@ env_get(Env, Name) ->
|
||||
|
||||
-spec env_set(Env1, Key, Value) -> Env2
|
||||
when Env1 :: #state{},
|
||||
Key :: {symbol, term()},
|
||||
Key :: {symbol, string()},
|
||||
Value :: term(),
|
||||
Env2 :: #state{}.
|
||||
env_set(Env, Name, Value) ->
|
||||
|
@ -22,6 +22,7 @@ pr_str(Value, Readably) ->
|
||||
{map, Map} -> pr_map(Map, Readably);
|
||||
{closure, _Binds, _Body, _Env} -> "#<function>";
|
||||
{function, _Func} -> "#<builtin>";
|
||||
{macro, _Binds, _Body, _Env} -> "#<macro>";
|
||||
{error, Reason} -> io_lib:format("error: ~s", [Reason])
|
||||
end.
|
||||
|
||||
|
230
erlang/src/step8_macros.erl
Normal file
230
erlang/src/step8_macros.erl
Normal file
@ -0,0 +1,230 @@
|
||||
%%%
|
||||
%%% Step 8: Macros
|
||||
%%%
|
||||
|
||||
-module(step8_macros).
|
||||
|
||||
-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(),
|
||||
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),
|
||||
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),
|
||||
eval(read("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME \~(first xs)) (if or_FIXME or_FIXME (or \~@(rest xs))))))))"), 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(Value, Env) ->
|
||||
case Value of
|
||||
{list, _L1} ->
|
||||
case macroexpand(Value, Env) of
|
||||
{list, _L2} = List -> eval_list(List, Env);
|
||||
AST -> AST
|
||||
end;
|
||||
_ -> eval_ast(Value, Env)
|
||||
end.
|
||||
|
||||
eval_list({list, []}, _Env) ->
|
||||
[];
|
||||
eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2]}, Env) ->
|
||||
Result = eval(A2, Env),
|
||||
case Result of
|
||||
{error, _R1} -> Result;
|
||||
_ ->
|
||||
env:set(Env, {symbol, A1}, Result),
|
||||
Result
|
||||
end;
|
||||
eval_list({list, [{symbol, "def!"}, _A1, _A2]}, _Env) ->
|
||||
throw("def! called with non-symbol");
|
||||
eval_list({list, [{symbol, "def!"}|_]}, _Env) ->
|
||||
throw("def! requires exactly two arguments");
|
||||
eval_list({list, [{symbol, "let*"}, A1, A2]}, Env) ->
|
||||
NewEnv = env:new(Env),
|
||||
let_star(NewEnv, A1),
|
||||
eval(A2, NewEnv);
|
||||
eval_list({list, [{symbol, "let*"}|_]}, _Env) ->
|
||||
throw("let* requires exactly two arguments");
|
||||
eval_list({list, [{symbol, "do"}|Args]}, Env) ->
|
||||
eval_ast({list, lists:droplast(Args)}, Env),
|
||||
eval(lists:last(Args), Env);
|
||||
eval_list({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({list, [{symbol, "if"}|_]}, _Env) ->
|
||||
throw("if requires test and consequent");
|
||||
eval_list({list, [{symbol, "fn*"}, {vector, Binds}, Body]}, Env) ->
|
||||
{closure, Binds, Body, Env};
|
||||
eval_list({list, [{symbol, "fn*"}, {list, Binds}, Body]}, Env) ->
|
||||
{closure, Binds, Body, Env};
|
||||
eval_list({list, [{symbol, "fn*"}|_]}, _Env) ->
|
||||
throw("fn* requires 2 arguments");
|
||||
eval_list({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({list, [{symbol, "eval"}|_]}, _Env) ->
|
||||
throw("eval requires 1 argument");
|
||||
eval_list({list, [{symbol, "quote"}, AST]}, _Env) ->
|
||||
AST;
|
||||
eval_list({list, [{symbol, "quote"}|_]}, _Env) ->
|
||||
throw("quote requires 1 argument");
|
||||
eval_list({list, [{symbol, "quasiquote"}, AST]}, Env) ->
|
||||
eval(quasiquote(AST), Env);
|
||||
eval_list({list, [{symbol, "quasiquote"}|_]}, _Env) ->
|
||||
throw("quasiquote requires 1 argument");
|
||||
eval_list({list, [{symbol, "defmacro!"}, {symbol, A1}, A2]}, Env) ->
|
||||
case eval(A2, Env) of
|
||||
{closure, Binds, Body, CE} ->
|
||||
Result = {macro, Binds, Body, CE},
|
||||
env:set(Env, {symbol, A1}, Result),
|
||||
Result;
|
||||
Result -> env:set(Env, {symbol, A1}, Result), Result
|
||||
end,
|
||||
Result;
|
||||
eval_list({list, [{symbol, "defmacro!"}, _A1, _A2]}, _Env) ->
|
||||
throw("defmacro! called with non-symbol");
|
||||
eval_list({list, [{symbol, "defmacro!"}|_]}, _Env) ->
|
||||
throw("defmacro! requires exactly two arguments");
|
||||
eval_list({list, [{symbol, "macroexpand"}, Macro]}, Env) ->
|
||||
macroexpand(Macro, Env);
|
||||
eval_list({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};
|
||||
A -> io:format("eval_list received ~w~n", [A]), throw("expected a list")
|
||||
end.
|
||||
|
||||
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]}.
|
||||
|
||||
is_macro_call({list, [{symbol, Name}|_]}, Env) ->
|
||||
case env:find(Env, {symbol, Name}) of
|
||||
nil -> false;
|
||||
Env2 ->
|
||||
case env:get(Env2, {symbol, Name}) of
|
||||
{macro, _Binds, _Body, _ME} -> true;
|
||||
_ -> false
|
||||
end
|
||||
end;
|
||||
is_macro_call(_AST, _Env) ->
|
||||
false.
|
||||
|
||||
macroexpand(AST, Env) ->
|
||||
case is_macro_call(AST, Env) of
|
||||
true ->
|
||||
{list, [Name|A]} = AST,
|
||||
{macro, Binds, Body, ME} = env:get(Env, Name),
|
||||
NewEnv = env:new(ME),
|
||||
env:bind(NewEnv, Binds, lists:flatten([A])),
|
||||
NewAST = eval(Body, NewEnv),
|
||||
macroexpand(NewAST, Env);
|
||||
false -> AST
|
||||
end.
|
Loading…
Reference in New Issue
Block a user