%% ---------------------------------------------------------------------
%% Licensed under the Apache License, Version 2.0 (the "License"); you may
%% not use this file except in compliance with the License. You may obtain
%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% @author Richard Carlsson <[email protected]>
%% @copyright 2012 Richard Carlsson
%% @doc Trivial Lisp interpreter in Erlang.
-module(lisp).
-export([eval/1]).
-export([init/0, equal/2, gt/2, knot/1]).
-record(st, {env}).
-define(INTERPRETED, true).
-include("lisp_test.erl").
eval(P) ->
{X, _} = eval(P, init()),
X.
init() ->
Env = [{print, {builtin, fun do_print/2}}
,{list, {builtin, fun do_list/2}}
,{apply, {builtin, fun do_apply/2}}
,{plus, {builtin, fun do_plus/2}}
,{equal, {builtin, fun do_equal/2}}
,{gt, {builtin, fun do_gt/2}}
,{knot, {builtin, fun do_knot/2}}
,{y, y()}
],
#st{env=dict:from_list(Env)}.
eval([lambda, Ps, B], #st{env=E}=St) when is_list(Ps) ->
case lists:all(fun is_atom/1, Ps) andalso
(length(Ps) =:= length(lists:usort(Ps))) of
true -> {{lambda, Ps, B, E}, St};
false -> throw(bad_lambda)
end;
eval([lambda | _], _) ->
throw(bad_lambda);
eval([def, A, V, B], #st{env=E0}=St) when is_atom(A) ->
{V1, St1} = eval(V, St),
E1 = bind(A, V1, E0),
{X, St2} = eval(B, St1#st{env=E1}),
{X, St2#st{env=E0}};
eval([def | _], _) ->
throw(bad_def);
eval([quote, A], St) ->
{A, St};
eval([quote | _], _) ->
throw(bad_quote);
eval([iff, X, A, B], St) ->
case eval(X, St) of
{[], St1} -> eval(B, St1);
{_, St1} -> eval(A, St1)
end;
eval([do], _St0) ->
throw(bad_do);
eval([do | As], St0) ->
lists:foldl(fun (X, {_,St}) -> eval(X, St) end, {[],St0}, As);
eval([_|_]=L, St) ->
{[F | As], St1} = lists:mapfoldl(fun eval/2, St, L),
call(F, As, St1);
eval(A, St) when is_atom(A) ->
{deref(A, St), St};
eval(C, St) ->
{C, St}.
%% UTILITY FUNCTIONS
deref(A, #st{env=E}) ->
case dict:find(A, E) of
{ok, V} -> V;
error -> throw({undefined, A})
end.
bind(A, V, E) ->
dict:store(A, V, E).
bind_args([P | Ps], [A | As], E) ->
bind_args(Ps, As, dict:store(P, A, E));
bind_args([], [], E) ->
E;
bind_args(_, _, _) ->
throw(bad_arity).
call({lambda, Ps, B, E}, As, #st{env=E0}=St) ->
{X, St1} = eval(B, St#st{env=bind_args(Ps, As, E)}),
{X, St1#st{env=E0}};
call({builtin, F}, As, St) ->
F(As, St);
call(X, _, _) ->
throw({bad_fun, X}).
bool(true) -> 1;
bool(false) -> [].
%% BUILTINS
y() ->
{Y, _} = eval([lambda, [f],
[[lambda, [x], [f, [lambda, [y], [[x, x], y]]]],
[lambda, [x], [f, [lambda, [y], [[x, x], y]]]]]],
#st{env=dict:new()}),
Y.
do_print([S | Xs], St) ->
io:format(S, Xs),
{[], St};
do_print(_, _) ->
throw(bad_print).
do_list(As, St) ->
{As, St}.
do_apply([F, As], St) ->
call(F, As, St);
do_apply(_, _) ->
throw(bad_apply).
do_plus([X, Y], St) when is_number(X), is_number(Y) ->
{X + Y, St};
do_plus(As, _) ->
throw({bad_plus, As}).
do_equal([X, Y], St) ->
{equal(X, Y), St};
do_equal(As, _) ->
throw({bad_equal, As}).
equal(X, Y) ->
bool(X =:= Y).
do_gt([X, Y], St) ->
{gt(X, Y), St};
do_gt(As, _) ->
throw({bad_gt, As}).
gt(X, Y) ->
bool(X > Y).
do_knot([X], St) ->
{knot(X), St};
do_knot(As, _) ->
throw({bad_gt, As}).
knot([]) ->
1;
knot(_) ->
[].
