%========================================================================
%
%  Implementation of an SECD machine in Prolog.  Extended to handle 
%  built-in functions.
%
%========================================================================

%
% Top-level interface to the SECD.  Evaluating Expr gives Result.
%

eval(Expr,Result) :- reduce(secd([],[],[Expr],[]), Result).


%
% Reduce(State,Result) is true if State is an SECD machine state and
% result is the value at the top of the S stack once State has been
% reduced to its final state.
%

reduce(State,_) :-	% Bit of a hack -- prints states as we go
	print_state(State), nl, fail.
reduce(State, Result) :-
	transform(State, NewState),
	reduce(NewState, Result).
reduce(secd([Result|_], _, [], []), Result).


print_state(secd(S,E,C,D)) :- 
	write('S: '), write(S), nl,
	write('E: '), write(E), nl,
	write('C: '), write(C), nl,
	write('D: '), write(D), nl.

	
%
% lookup(Var,Env,Value) is true if Value is the first binding for
% Var in Env, or if Env contains no bindings for Var and Value=Var.
%

lookup(X,[b(X,V)|_],V).	  
lookup(X,[b(Y,_)|E],V) :- X\=Y, lookup(X,E,V).
lookup(X,[],X).		 

%
% Collection of facts about built-in functions
%
built_in_fn(inc, N, V) :- V is N+1.
built_in_fn(dec, N, V) :- V is N-1.
built_in_fn(iszero, 0, cl(x,lam(y,x),[])).
built_in_fn(iszero, N, cl(x,lam(y,y),[])) :- N =\= 0.
	
	
% Rule 1: There's a constant at the top of the control stack
%
transform(secd(S, E, [C|Cs], D),
          secd([C|S], E, Cs, D)) :- integer(C).

% Rule 2: There's a variable at the top of the control stack.  Evaluate
% the variable in the current environment and push the value onto the
% stack of evaluated expressions.
%
transform(secd(S, E, [Var|Cs], D),
          secd([Val|S], E, Cs, D)) :- atom(Var), Var \= '@', lookup(Var,E,Val).
	
% Rule 3:  The top expression is the application of a function to an
% argument.  Push both the function expression and the argument onto
% the control stack to be evaluated.  Also leave an @ on the stack, 
% so we know when the pieces have been evaluated and can be applied.
%
transform(secd(S, E, [app(F,Arg)|Cs], D),
          secd(S, E, [F, Arg, @|Cs], D)).

% Rule 4:  There's a lambda expression at the top of the stack.  We
% must create a cl, capturing the current environment so it can
% be used to evaluate any unbound variables in the body of the lambda
% expression when it's applied to something.
%
transform(secd(S, E, [lam(V,B)|Cs], D),
          secd([cl(V,B,E)|S], E, Cs, D)).

% Rule 5:  We find an @ at the top of the control stack, which implies
% that we've previously evaluated both a function and its argument, and
% we can finally apply the function to its arg, both of which are on top
% of the S stack.
%
transform(secd([Arg,F|Ss], E, [@|Cs], D),
          secd([Val|Ss], E, Cs, D)) :- built_in_fn(F,Arg,Val).

% Rule 6:  Similar to rule #5, but the function that needs to be 
% applied is a lambda closure that's currently atop the S stack along
% with its argument.  We capture the current state of the machine and
% push it onto D, so that we can restore it once we're done.  We then
% associate the lambda's parameter, V, with the value of the argument, 
% Arg, and evaluate the body, B.
%
transform(secd([Arg,cl(V,B,E1)|S], E, [@|Cs], D),
          secd([],[b(V,Arg)|E1], [B], [state(S,E,Cs)|D])).

% Rule 7:  The control stack is empty, but there are still some stored
% states on the dump.  Restore the machine to the state stored atop D
% and continue.
%
transform(secd([S|_], _, [], [state(S1,E1,C1)|Ds]),
          secd([S|S1], E1, C1, Ds)).