erlisp.erl

% An ad hoc, informally-specified, bug-ridden, slow implementation of half of Lisp
%
% start like: erlc erlisp.erl && rlwrap erl -noshell -s erlisp -s init stop
% quoting and eval are not working.
% one example that works:
%  (set triple (lambda (n) (* n 3)))
%  (triple 3)
%
% Any feedback on what I'm doing wrong or how to improve appreciated.
% twitter.com/metabrew
%
-module(erlisp).
-compile(export_all).

-record(state, {defs}).

% eval a single string:
eval(List) -> 
    Defs = ets:new(state, [set]),
    State = #state{defs=Defs},
    Parsed = parse(List),
    io:format("Parse tree: ~p\n", [Parsed]),
    hd(do_eval(Parsed, State)).

% enter repl:
start() ->
    Defs = ets:new(state, [set]),
    State = #state{defs=Defs},
    repl_loop(State).

repl_loop(State) ->
    case io:get_line("erlisp> ") of
        eof -> ok;
        {error,_} -> error;
        "quit"++_ -> quit;
        "traceon"  -> dbgon(?MODULE,do_eval), repl_loop(State);
        "traceoff" -> dbgoff(), repl_loop(State);
        "reload"++_ -> 
            {ok, _} = compile:file(atom_to_list(?MODULE)++".erl"),
            code:purge(?MODULE), code:load_file(?MODULE),
            ?MODULE:repl_loop(State);
        Str ->
            Str1 = string:strip(string:strip(string:strip(Str,both,$\n), both, $\r)),
            case Str1 of
                "" -> repl_loop(State);
                _ ->
                    Parsed = parse(Str1),
                    %io:format("Parse tree: ~p\n", [Parsed]),
                    Ret = hd(do_eval(Parsed, State)),
                    io:format("~p~n", [Ret]),
                    repl_loop(State)
            end
    end.

do_eval(['eq',A,B], State)  -> do_eval(A,State) == do_eval(B, State);
do_eval(['if',Cond,Exp], State) -> do_eval(['ifelse',Cond,Exp,[]], State);
do_eval(['ifelse',Cond,ExpIf,ExpElse], State) ->
    case do_eval(Cond, State) of
        true -> do_eval(ExpIf, State);
        false -> do_eval(ExpElse, State)
    end;
do_eval(['+'|T], State)     -> lists:foldl(fun(El, AccIn)-> do_eval(El, State) + AccIn end, 0, T);
do_eval(['-',T1|T2], State) -> lists:foldl(fun(El, AccIn)-> AccIn - do_eval(El, State) end, do_eval(T1, State), T2);
do_eval(['*'|T], State)     -> lists:foldl(fun(El, AccIn)-> do_eval(El, State) * AccIn end, 1, T);
do_eval(['/',A,B], State)   -> do_eval(A, State) / do_eval(B, State);
do_eval(['car'|[List]], _State) when is_list(List) -> hd(List);
do_eval(['cdr'|[List]], _State) when is_list(List) -> tl(List);
%do_eval(['@',List], _State)   when is_list(List) -> List;
do_eval(['quote'|List], _State) -> {quoted, hd(List)};

do_eval(['eval'|T], State) -> {eval, do_eval(hd(T),State)};
    
% (set a 3)
do_eval(['set',K,V], State) when is_atom(K) ->
    Def = do_eval(V, State), % do_eval first to close in any referenced vars
    ets:insert(State#state.defs, {K, Def}),
    K;

% (lambda (n) (n * 2))
do_eval(['lambda',Args,Exp], _State) ->
    Def = Exp, % todo closure/bind vars
    F = fun(PassedArgs, State1) ->
        St =lists:zip(Args,PassedArgs),
        ets:insert(State1#state.defs, St),
        do_eval(Def, State1)
    end,
    {lambda, F, length(Args)};

% expand any set/functions and reeval
do_eval([Atom|T], State) when is_atom(Atom) ->
    case ets:lookup(State#state.defs, Atom) of
        [] -> [Atom | do_eval(T,State) ];
        [{_X, V}] -> do_eval([V|T], State)
    end;


%do_eval([{quoted, Exp}], _State) -> [Exp];

do_eval([{lambda, Fun, Arity}|Args], State) when is_function(Fun), length(Args) == Arity -> Fun(Args, State);

do_eval(X, State) when not is_list(X) -> 
   case ets:lookup(State#state.defs, X) of
       [] -> X;
       [{X, V}] -> do_eval(V, State)
   end;

do_eval([], _State)    -> [];
do_eval([H|T], State) -> [case H1 = do_eval(H, State) of
                              [{lambda,_,_}|_] -> do_eval(H1, State);
                              [{eval, {quoted, Exp}}|HT] -> do_eval([Exp|HT], State);
                              _ -> H1
                          end
                          | 
                          case T1 = do_eval(T, State) of
                              [{lambda,_,_}|_] -> do_eval(T1, State);
                              [{eval, {quoted, Exp}}|HT] -> do_eval([Exp|HT], State);
                              _ -> T1
                          end].


% parser
parse(Str) ->  parse(Str,[], 0, -1).

parse("", State, _, _) -> lists:reverse(State);
parse(Str, State, Depth, Q) ->
    {Tok, Rest} = next_token(Str),
    %io:format("[~p] parse: ~s State:~p  tok:~p rest=~p q=~p\n", [Depth, Str, State, Tok, Rest, Q]),
    case Tok of
        $) -> {Rest, State};
        $( -> {Rest1, State1} = parse(Rest, [], Depth+1, Q),
              case Q == Depth of
                true ->
                    S = {quoted, lists:reverse(State1)},
                    parse(Rest1, [S|State], Depth, -1);
                false ->
                    parse(Rest1, [lists:reverse(State1)|State], Depth, Q)
              end;
%        $@ -> parse(Rest, State, Depth, Depth);
        Sym ->
              Scalar = parse_scalar(Sym),
              case Q == Depth of
                true ->
                    parse(Rest, [{quoted, Scalar}|State], Depth, -1);
                false ->
                    parse(Rest, [Scalar|State], Depth, Q)
            end
    end.


% lexing
next_token(Str) -> tok(string:strip(Str), "").
tok([], Tok)        -> {Tok, []};
tok([$(|T], "")     -> {$(, T};
tok([$)|T], "")     -> {$), T};
tok([$ |T], Tok)    -> {Tok, T};
%tok([$@|T], "")     -> {$@, T};
tok([H|T], Tok) when (H == $ ) orelse (H == $() orelse (H == $)) 
                    -> {Tok, [H|T]};
tok([H|T], Tok)     -> tok(T, Tok++[H]).
    
% convert string to int/float/atom/etc
parse_scalar(S) ->
    case string:to_float(S) of
        {error, _} ->
            case string:to_integer(S) of
                {error, _} ->
                    list_to_atom(S);
                {Int,""} -> Int
            end;
        {Float,""} -> Float
    end.


% erlang debug stuff for tracing execution:

dbgon(Module, Fun) when is_atom(Fun) -> 
    {ok,_} = dbg:tracer(), 
    dbg:p(all,call), 
    dbg:tpl(Module, Fun, [{'_',[],[{return_trace}]}]), 
    ok. 

dbgoff() -> dbg:stop(). 

dbgon(Module) -> 
    dbg:tracer(),
            dbg:p(all,call), 
            dbg:tpl(Module, [{'_',[],[{return_trace}]}]), 
            ok.
%        E -> E
%    end.