1
1
mirror of https://github.com/kanaka/mal.git synced 2024-09-20 01:57:09 +03:00

Step 4 of Make-a-Lisp for Erlang

make test^erlang^step0 passes
make test^erlang^step1 passes
make test^erlang^step2 passes
make test^erlang^step3 passes
make test^erlang^step4 passes
This commit is contained in:
Nathan Fiedler 2015-03-21 18:01:42 -07:00
parent 583a62df35
commit a61ea75a99
10 changed files with 380 additions and 77 deletions

View File

@ -1,12 +1,13 @@
#####################
SOURCES_BASE = src/step0_repl.erl src/step1_read_print.erl src/step2_eval.erl src/step3_env.erl
SOURCES_LISP = src/core.erl src/env.erl src/reader.erl
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
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
SRCS = step0_repl.erl step1_read_print.erl step2_eval.erl step3_env.erl step4_if_fn_do.erl
BINS = $(SRCS:%.erl=%)
#####################

View File

@ -13,5 +13,6 @@
"step0_repl",
"step1_read_print",
"step2_eval",
"step3_env"
"step3_env",
"step4_if_fn_do"
]}.

View File

@ -5,16 +5,55 @@
-module(core).
-compile(export_all).
%%
%% Numeric functions
%%
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([]) ->
{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([]) ->
{error, "empty? called with no arguments"};
empty_q(_) ->
{error, "empty? expects one list argument"}.
equal_q(Args) ->
case Args of
[nil, nil] -> true;
[true, true] -> true;
[false, false] -> true;
[{integer, I}, {integer, J}] -> I == J;
[{string, S}, {string, T}] -> S == T;
[{keyword, K}, {keyword, J}] -> K == J;
[{symbol, S}, {symbol, T}] -> S == T;
[{list, L1}, {list, L2}] -> L1 == L2;
[{vector, L1}, {vector, L2}] -> L1 == L2;
[{list, L1}, {vector, L2}] -> L1 == L2;
[{vector, L1}, {list, L2}] -> L1 == L2;
[{map, M1}, {map, M2}] -> M1 == M2;
[{closure, _C1}, {closure, _C2}] -> false;
[{function, _F1}, {function, _F2}] -> false;
[_A, _B] -> false;
_ -> {error, "equal? expects two arguments"}
end.
int_op(F, [A0,A1]) ->
case A0 of
{integer, I0} ->
case A1 of
{integer, I1} ->
F(I0, I1);
{integer, F(I0, I1)};
_ -> {error, "second argument must be an integer"}
end;
_ -> {error, "first argument must be an integer"}
@ -23,20 +62,78 @@ int_op(_F, _L) ->
{error, "must have two arguments"}.
int_add(Args) ->
{integer, int_op(fun(I, J) -> I + J end, Args)}.
int_op(fun(I, J) -> I + J end, Args).
int_sub(Args) ->
{integer, int_op(fun(I, J) -> I - J end, Args)}.
int_op(fun(I, J) -> I - J end, Args).
int_mul(Args) ->
{integer, int_op(fun(I, J) -> I * J end, Args)}.
int_op(fun(I, J) -> I * J end, Args).
int_div(Args) ->
{integer, int_op(fun(I, J) -> I div J end, Args)}.
int_op(fun(I, J) -> I div J end, Args).
bool_op(F, [A0,A1]) ->
case A0 of
{integer, I0} ->
case A1 of
{integer, I1} ->
% the true or false is our return value
F(I0, I1);
_ -> {error, "second argument must be an integer"}
end;
_ -> {error, "first argument must be an integer"}
end;
bool_op(_F, _L) ->
{error, "must have two arguments"}.
bool_lt(Args) ->
bool_op(fun(I, J) -> I < J end, Args).
bool_lte(Args) ->
bool_op(fun(I, J) -> I =< J end, Args).
bool_gt(Args) ->
bool_op(fun(I, J) -> I > J end, Args).
bool_gte(Args) ->
bool_op(fun(I, J) -> I >= J end, Args).
pr_str(Args) ->
{string, printer:pr_list(Args, "", "", " ", true)}.
str(Args) ->
{string, printer:pr_list(Args, "", "", "", false)}.
prn(Args) ->
io:format("~s~n", [printer:pr_list(Args, "", "", " ", true)]),
nil.
println(Args) ->
io:format("~s~n", [printer:pr_list(Args, "", "", " ", false)]),
nil.
ns() ->
E1 = env:new(undefined),
E2 = env:set(E1, {symbol, "+"}, fun int_add/1),
E3 = env:set(E2, {symbol, "-"}, fun int_sub/1),
E4 = env:set(E3, {symbol, "*"}, fun int_mul/1),
env:set(E4, {symbol, "/"}, fun int_div/1).
Builtins = #{
"*" => fun int_mul/1,
"+" => fun int_add/1,
"-" => fun int_sub/1,
"/" => fun int_div/1,
"<" => fun bool_lt/1,
"<=" => fun bool_lte/1,
"=" => fun equal_q/1,
">" => fun bool_gt/1,
">=" => fun bool_gte/1,
"count" => fun count/1,
"empty?" => fun empty_q/1,
"list" => fun types:list/1,
"list?" => fun types:list_p/1,
"pr-str" => fun pr_str/1,
"println" => fun println/1,
"prn" => fun prn/1,
"str" => fun str/1
},
SetEnv = fun(K, V, AccIn) ->
env:set(AccIn, {symbol, K}, types:func(V))
end,
maps:fold(SetEnv, env:new(undefined), Builtins).

View File

@ -4,22 +4,37 @@
-module(env).
-export([new/1, set/3, get/2]).
-export([new/0, new/1, bind/3, set/3, get/2, fallback/2]).
-record(env, {outer, data}).
-record(env, {outer, data, fallback=undefined}).
%%
%% Public API
%%
-spec new() -> Env
when Env :: #env{}.
new() ->
new(undefined).
-spec new(Outer) -> Env
when Outer :: #env{},
Env :: #env{}.
% Construct a new environment; use 'undefined' for Outer is this is the
% root environment.
new(Outer) ->
#env{outer=Outer, data=#{}}.
-spec bind(Env1, Names, Values) -> Env2
when Env1 :: #env{},
Names :: [term()],
Values :: [term()],
Env2 :: #env{}.
bind(Env, [], []) ->
Env;
bind(Env, [{symbol, "&"},Name], Values) ->
set(Env, Name, {list, Values});
bind(Env, [Name|Ntail], [Value|Vtail]) ->
bind(set(Env, Name, Value), Ntail, Vtail).
-spec set(Env1, Key, Value) -> Env2
when Env1 :: #env{},
Key :: {symbol, term()},
@ -47,6 +62,13 @@ get(Env, Key) ->
_ -> throw("env:get/2 called with non-symbol key")
end.
-spec fallback(Env1, Fallback) -> Env2
when Env1 :: #env{},
Fallback :: #env{},
Env2 :: #env{}.
fallback(Env, Fallback) ->
#env{outer=Env#env.outer, data=Env#env.data, fallback=Fallback}.
%%
%% Internal functions
%%
@ -56,7 +78,11 @@ find(Env, Name) ->
true -> Env;
false ->
case Env#env.outer of
undefined -> nil;
undefined ->
case Env#env.fallback of
undefined -> nil;
Fallback -> find(Fallback, Name)
end;
Outer -> find(Outer, Name)
end
end.

View File

@ -4,7 +4,7 @@
-module(printer).
-export([pr_str/2]).
-export([pr_str/2, pr_list/5]).
-spec pr_str(term(), true|false) -> string().
pr_str(Value, Readably) ->
@ -13,20 +13,25 @@ pr_str(Value, Readably) ->
true -> "true";
false -> "false";
{integer, Num} -> integer_to_list(Num);
{string, String} -> io_lib:format("~s", [escape_str(String, Readably)]);
{keyword, Keyword} -> io_lib:format("~s", [[$:|Keyword]]);
{symbol, Symbol} -> io_lib:format("~s", [Symbol]);
{list, List} -> pr_list(List, $(, $), Readably);
{vector, Vector} -> pr_list(Vector, $[, $], Readably);
{map, Map} -> pr_map(Map, Readably)
{string, String} when Readably == true -> escape_str(String);
{string, String} when Readably == false -> String;
{keyword, Keyword} -> [$:|Keyword];
{symbol, Symbol} -> Symbol;
{list, List} -> pr_list(List, "(", ")", " ", Readably);
{vector, Vector} -> pr_list(Vector, "[", "]", " ", Readably);
{map, Map} -> pr_map(Map, Readably);
{closure, _Binds, _Body, _Env} -> "#<function>";
{function, _Func} -> "#<builtin>";
{error, Reason} -> io_lib:format("error: ~s", [Reason])
end.
pr_list(Seq, Start, End, Readably) ->
-spec pr_list([term()], string(), string(), string(), boolean()) -> string().
pr_list(Seq, Start, End, Join, Readably) ->
Print = fun(Elem) ->
pr_str(Elem, Readably)
end,
L = string:join(lists:map(Print, Seq), " "),
io_lib:format("~c~s~c", [Start, L, End]).
L = string:join(lists:map(Print, Seq), Join),
Start ++ L ++ End.
pr_map(Map, Readably) ->
PrintKV = fun({Key, Value}) ->
@ -37,14 +42,13 @@ pr_map(Map, Readably) ->
L = string:join(lists:map(PrintKV, maps:to_list(Map)), " "),
io_lib:format("{~s}", [L]).
escape_str(String, false) ->
"\"" ++ String ++ "\"";
escape_str(String, true) ->
escape_str(String) ->
Escape = fun(C, AccIn) ->
case C of
$" -> [C, $\\|AccIn];
$\\ -> [C, $\\|AccIn];
$\n -> [C, $\\|AccIn];
_ -> [C|AccIn]
end
end,
escape_str(lists:reverse(lists:foldl(Escape, [], String)), false).
"\"" ++ lists:reverse(lists:foldl(Escape, [], String)) ++ "\"".

View File

@ -125,7 +125,7 @@ read_meta(Reader) ->
case read_form(Reader2) of
{ok, Reader3} ->
X = Reader3#reader.tree,
Result = {list, [{symbol, 'with-meta'}, X, M]},
Result = {list, [{symbol, "with-meta"}, X, M]},
{ok, #reader{tokens=Reader3#reader.tokens, tree=Result}};
{error, Reason} -> {error, Reason}
end;
@ -214,7 +214,6 @@ lex_string([$\\,Escaped|Rest], String) ->
% unescape the string while building it
case Escaped of
[] -> {error, "end of string reached in escape"};
% TODO: should probably only allow \" and \n
_ -> lex_string(Rest, [Escaped|String])
end;
lex_string([$"|Rest], String) ->

View File

@ -7,7 +7,12 @@
-export([main/1]).
main(_) ->
Env = core:ns(),
Env = #{
"+" => fun core:int_add/1,
"-" => fun core:int_sub/1,
"*" => fun core:int_mul/1,
"/" => fun core:int_div/1
},
loop(Env).
loop(Env) ->
@ -38,15 +43,13 @@ read(String) ->
{error, Reason} -> io:format("error: ~s~n", [Reason]), nil
end.
eval({list, List}, Env) ->
case eval_ast({list, List}, Env) of
{list, [F|Args]} -> erlang:apply(F, [Args]);
_ -> {error, "expected a list"}
end;
eval(Value, Env) ->
case Value of
{list, _List} ->
case eval_ast(Value, Env) of
{list, [F|Args]} -> erlang:apply(F, [Args]);
_ -> {error, "expected a list"}
end;
_ -> eval_ast(Value, Env)
end.
eval_ast(Value, Env).
eval_ast(Value, Env) ->
EvalList = fun(Elem) ->

View File

@ -29,37 +29,30 @@ read(Input) ->
{error, Reason} -> throw(Reason)
end.
eval({list, []}, Env) ->
{[], Env};
eval({list, [{symbol, "def!"}, A1, A2]}, Env) ->
case A1 of
{symbol, _A1} ->
{Atwo, E2} = eval(A2, Env),
{Atwo, env:set(E2, A1, Atwo)};
_ -> throw("def! called with non-symbol")
end;
eval({list, [{symbol, "def!"}|_]}, _Env) ->
throw("def! requires exactly two arguments");
eval({list, [{symbol, "let*"}, A1, A2]}, Env) ->
{Result, _E} = eval(A2, let_star(Env, A1)),
{Result, Env};
eval({list, [{symbol, "let*"}|_]}, _Env) ->
throw("let* requires exactly two arguments");
eval({list, List}, Env) ->
case eval_ast({list, List}, Env) of
{{list, [{function, F}|A]}, E2} ->
{erlang:apply(F, [A]), E2};
_ -> throw("expected a list with a function")
end;
eval(Value, Env) ->
case Value of
{list, []} -> {Value, Env};
{list, [First|Args]} ->
case First of
{symbol, "def!"} ->
case Args of
[A1,A2] ->
case A1 of
{symbol, _A1} ->
{Atwo, E2} = eval(A2, Env),
{Atwo, env:set(E2, A1, Atwo)};
_ -> throw("def! called with non-symbol")
end;
_ -> throw("def! requires exactly two arguments")
end;
{symbol, "let*"} ->
case Args of
[A1,A2] ->
{Result, _E} = eval(A2, let_star(Env, A1)),
{Result, Env};
_ -> throw("let* requires exactly two arguments")
end;
_ ->
case eval_ast(Value, Env) of
{{list, [F|A]}, E2} -> {erlang:apply(F, [A]), E2};
_ -> throw("expected a list")
end
end;
_ -> eval_ast(Value, Env)
end.
eval_ast(Value, Env).
eval_ast(Value, Env) ->
EvalList = fun(Elem, AccIn) ->

View File

@ -0,0 +1,157 @@
%%%
%%% Step 4: if, fn, do
%%%
-module(step4_if_fn_do).
-export([main/1]).
main(_) ->
% define the not function using mal itself
AST = read("(def! not (fn* (a) (if a false true)))"),
{_Result, Env} = eval(AST, core:ns()),
loop(Env).
loop(Env) ->
case io:get_line(standard_io, "user> ") of
eof -> io:format("~n");
{error, Reason} -> exit(Reason);
Line -> loop(rep(string:strip(Line, both, $\n), Env))
end.
rep(Input, Env) ->
try eval(read(Input), Env) of
{Result, E} -> print(Result), E
catch
throw:Reason -> io:format("error: ~s~n", [Reason]), Env
end.
read(Input) ->
case reader:read_str(Input) of
{ok, Value} -> Value;
{error, Reason} -> throw(Reason)
end.
eval({list, []}, Env) ->
{[], Env};
eval({list, [{symbol, "def!"}, A1, A2]}, Env) ->
case A1 of
{symbol, _A1} ->
{Atwo, E2} = eval(A2, Env),
{Atwo, env:set(E2, A1, Atwo)};
_ -> throw("def! called with non-symbol")
end;
eval({list, [{symbol, "def!"}|_]}, _Env) ->
throw("def! requires exactly two arguments");
eval({list, [{symbol, "let*"}, A1, A2]}, Env) ->
{Result, _E} = eval(A2, let_star(Env, A1)),
{Result, Env};
eval({list, [{symbol, "let*"}|_]}, _Env) ->
throw("let* requires exactly two arguments");
eval({list, [{symbol, "do"}|Args]}, Env) ->
{{list, Results}, E2} = eval_ast({list, Args}, Env),
{lists:last(Results), E2};
eval({list, [{symbol, "if"}, Test, Consequent|Alternate]}, Env) ->
EvalAlternate = fun(Alt) ->
case Alt of
[] -> {nil, Env};
[A] -> eval(A, Env);
_ -> throw("if takes 2 or 3 arguments")
end
end,
case eval(Test, Env) of
{false, _E2} -> EvalAlternate(Alternate);
{nil, _E2} -> EvalAlternate(Alternate);
_ -> 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}, Env};
eval({list, [{symbol, "fn*"}, {list, Binds}, Body]}, Env) ->
{{closure, Binds, Body, Env}, Env};
eval({list, [{symbol, "fn*"}|_]}, _Env) ->
throw("fn* requires 2 arguments");
eval({list, List}, Env) ->
case eval_ast({list, List}, Env) of
{{list, [{closure, Binds, Body, CE}|A]}, E2} ->
% args may be a single element or a list, so
% always make it a list and then flatten it
CA = lists:flatten([A]),
% hack to permit a closure to know its own
% name, from the child environment
Bound = env:bind(CE, Binds, CA),
BoundWithFallback = env:fallback(Bound, E2),
{Result, _E} = eval(Body, BoundWithFallback),
% discard the environment from the closure
{Result, Env};
{{list, [{function, F}|A]}, E2} ->
{erlang:apply(F, [A]), E2};
_ -> throw("expected a list")
end;
eval(Value, Env) ->
eval_ast(Value, Env).
eval_ast(Value, Env) ->
EvalList = fun(Elem, AccIn) ->
{List, E} = AccIn,
{Result, E2} = eval(Elem, E),
{[Result|List], E2}
end,
EvalMap = fun(Key, Val, AccIn) ->
{Map, E} = AccIn,
{Result, E2} = eval(Val, E),
{maps:put(Key, Result, Map), E2}
end,
case Value of
{symbol, _Sym} -> {env:get(Env, Value), Env};
{list, L} ->
{Results, E2} = lists:foldl(EvalList, {[], Env}, L),
{{list, lists:reverse(Results)}, E2};
{vector, V} ->
{Results, E2} = lists:foldl(EvalList, {[], Env}, V),
{{vector, lists:reverse(Results)}, E2};
{map, M} ->
{Results, E2} = maps:fold(EvalMap, {#{}, Env}, M),
{{map, Results}, E2};
_ -> {Value, Env}
end.
print(Value) ->
case Value of
none -> ok; % if nothing meaningful was entered, print nothing at all
_ -> io:format("~s~n", [printer:pr_str(Value, true)])
end.
let_star(Env, Bindings) ->
% (let* (p (+ 2 3) q (+ 2 p)) (+ p q))
% ;=>12
Bind = fun({Name, Expr}, E) ->
case Name of
{symbol, _Sym} ->
{Value, E2} = eval(Expr, E),
env:set(E2, Name, Value);
_ -> throw("let* with non-symbol binding")
end
end,
BindAll = fun(List) ->
case list_to_proplist(List) of
{error, Reason} -> throw(Reason);
Props -> lists:foldl(Bind, Env, Props)
end
end,
case Bindings of
{list, Binds} -> BindAll(Binds);
{vector, Binds} -> BindAll(Binds);
_ -> 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]).

22
erlang/src/types.erl Normal file
View File

@ -0,0 +1,22 @@
%%%
%%% Types and their functions
%%%
-module(types).
-compile(export_all).
list(Args) ->
{list, Args}.
list_p([Args]) ->
case Args of
{list, _L} -> true;
_ -> false
end;
list_p([]) ->
{error, "list? called with no arguments"};
list_p(_) ->
{error, "list? expects one list argument"}.
func(Func) ->
{function, Func}.