#####################
-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=%)
#####################
"step0_repl",
"step1_read_print",
"step2_eval",
- "step3_env"
+ "step3_env",
+ "step4_if_fn_do"
]}.
-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"}
{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).
-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()},
_ -> 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
%%
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.
-module(printer).
--export([pr_str/2]).
+-export([pr_str/2, pr_list/5]).
-spec pr_str(term(), true|false) -> string().
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}) ->
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)) ++ "\"".
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;
% 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) ->
-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) ->
{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) ->
{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) ->
--- /dev/null
+%%%
+%%% 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]).
--- /dev/null
+%%%
+%%% 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}.
HCoop / jackhill / mal.git / commitdiff