%%% problem14.pl
%%% This file implements evaluation for uML.
%%% The problem says nothing about type-checking uML input so
%%% we assume that ill-typed input will just fail to evaluate due
%%% to lack of evaluation rules.

%%% we use "true" and "false" internally for boolean values, but can print 
%%% #t and #f using the SWIprolog builtin portray/1.

%portray(true) :- print('#t').
%portray(false) :- print('#f').

%%% environment manipulation, uses handy infix operator ->
%%% find (Var-,Env+,Val-) finds the value for a variable in an environment
%%%   or fails if not bound.
%%% bind (Var+,Val+,OldEnv+,NewEnv-) adds a binding to an environment.
%%% bindlist(Vars+,Vals+,Oldenv+,Newenv-) adds multiple bindings.
%%%

find(X,[X -> Y|_],Y) :- !.
find(X,[_|L],Y) :- find(X,L,Y).

bind(X,Y,L,[X -> Y | L]).
  
bindlist([], [], Rho, Rho).
bindlist([HX|TX], [HV|TV], Rho, Rho2) :-
  bind(HX, HV, Rho, Rho3), 
  bindlist(TX, TV, Rho3, Rho2).

%%% unzip for [(x1,e1), ..., (xn,en)]
%%%
unzip([],[],[]).
unzip([(X,E)|More],[X|MoreXs],[E|MoreEs]) :- unzip(More,MoreXs,MoreEs).

%%% opposite used for some relational expressions.
%%%
opposite(lt, ge).
opposite(gt, le).
opposite(eq, ne).

%%% Binary operation for primitive operations.
%%% the boolean operations have values in {true, false}

binop(cons,  X, Y, [X,Y]).
binop(append,X, Y, Z) :- append(X,Y,Z).
binop(and,   true, true, true) :- !.  /* do not backtrack to try false! */
binop(and,   _, _, false).
binop(or,    false, false, false) :- !. /* do not backtrack to try true! */
binop(or,    _, _, true).
binop(plus,  X, Y, V) :- V is X + Y.
binop(minus, X, Y, V) :- V is X - Y.
binop(times, X, Y, V) :- V is X * Y.
binop(div,   X, Y, V) :- V is X / Y.
binop(lt,  X, Y, true) :- X < Y.
binop(gt,  X, Y, true) :- X > Y.
binop(eq,  X, Y, true) :- X =:= Y.
binop(le,  X, Y, true) :- X =< Y.
binop(ge,  X, Y, true) :- X >= Y.
binop(ne,  X, Y, true) :- X =\= Y.
binop(C, X, Y, false) :- 
  opposite(C, C1), 
  binop(C1, X, Y, true).

is_binop(X) :- member(X, [cons, append, and, or, plus, minus, times, div,
                          lt, gt, eq, le, ge, ne]).

unop(car, [X,_], X).
unop(cdr, [_,Y], Y).
unop(list1, X, [X]).
unop(length, X, N) :- length(X,N).
unop(not, true, false).
unop(not, false, true).

is_unop(X) :- member(X, [car, cdr, list1, length, not]).
 
%%% evallist used by eval

evallist([], _Rho, []) :- !. /* succeeded or failed: do not retry */
evallist([HE|TE], Rho, [HV|TV]) :- eval(HE, Rho, HV), evallist(TE, Rho, TV).

%%% eval(+Expression,+Environment,-Value)
%%% 
eval(print(E), Rho, V) :- eval(E, Rho, V), print(V).
%
% evaluate literals 
% pair and nil make prolog lists.
%
eval(literal(true), _Rho, true) :- !.
eval(literal(false), _Rho, false) :- !.
eval(literal(nil), _Rho, []) :- !.
eval(literal(pair(H,T)), _Rho, .(LH,LT)) :-
  eval(literal(H), _Rho, LH),
  eval(literal(T), _Rho, LT).
eval(literal(X), _Rho, X) :- atomic(X).
%
eval(var(X), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(if(E1, E2, E3), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(lambda(XS, E), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(begin(Es), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(apply(E, ES), Rho, V) :-
  eval(E, Rho, Op), 
  is_binop(Op),
  evallist(ES, Rho, [X,Y]), 
  binop(Op, X, Y, V).           /* binary primitive operations */
eval(apply(E, ES), Rho, V) :-
  eval(E, Rho, Op),
  is_unop(Op),
  evallist(ES, Rho, [X]), 
  unop(Op, X, V).		/* unary primitive operations */
eval(apply(E, ES), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(let(Bs,Body), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(letstar(Bs,Body), Rho, V) :- print('LeftAsExercise'), !, fail.
%
eval(letrec(Bs,Body), Rho, V) :- print('LeftAsExercise'), !, fail.
%
% The names of all primops are self-evaluating
%
eval(X, _, X) :- is_binop(X).
eval(X, _, X) :- is_unop(X).