% Unlambda interpreter

% PARSING
parse(S) :- get_char(C), parse_char(C, S).

parse_char(' ', S) :- parse(S).
parse_char('\n', S) :- parse(S).
parse_char('#', S) :- skip, parse(S).
parse_char('`', '`'(A, B)) :- parse(A), parse(B).
parse_char('.', '.'(C)) :- get_char(C).
parse_char('?', '?'(C)) :- get_char(C).
% standard Prolog has no case conversion functions! Arggggg
% parse_char(C, S) :- downcase_atom(C, S).
parse_char('S', s).
parse_char('K', k).
parse_char('I', i).
parse_char('V', v).
parse_char('R', r).
parse_char('C', c).
parse_char('D', d).
parse_char('E', e).
parse_char(C, C).
% NB: I'm lazy, thus single character functions are checked for validity
% only when applied.

skip :- repeat, get_char(C), (C = '\n'; C = end_of_file; fail).

% EVALUATION

ret(A, C, ev1(B, S)) :- !, ev1(A, B, C, S).
ret(B, C, ap(A, S)) :- !, ap(A, B, C, S).
ret(_, _, end).% :- write('result: '), write(A), nl.

ev('`'(A, B), C, S) :- !, ev(A, C, ev1(B, S)).
ev(A, C, S) :- !, ret(A, C, S).

ev1(d, B, C, S) :- !, ret(d(B), C, S).
ev1(A, B, C, S) :- !, ev(B, C, ap(A, S)).

ap(s, B, C, S) :- !, ret(s(B), C, S).
ap(s(A), B, C, S) :- !, ret(s(A, B), C, S).
ap(s(A1, A2), B, C, S) :- !, ev('`'('`'(A1, B), '`'(A2, B)), C, S).

ap(k, B, C, S) :- !, ret(k(B), C, S).
ap(k(A), _, C, S) :- !, ret(A, C, S).

ap(d(A), B, C, S) :- !, ev('`'(A, B), C, S).

ap(c, B, C, S) :- !, ev('`'(B, c(S)), C, S).
ap(c(A), B, C, _) :- !, ret(B, C, A).

ap(i, B, C, S) :- !, ret(B, C, S).
ap(v, _, C, S) :- !, ret(v, C, S).
ap('.'(A), B, C, S) :- put_char(A), !, ret(B, C, S).
ap(r, B, C, S) :- nl, !, ret(B, C, S).
ap('@', B, _, S) :- get_char(C),
	!, (C = end_of_file -> ev('`'(B, v), C, S); ev('`'(B, i), C, S)).
ap('?'(A), B, C, S) :-
	!, (A = C -> ev('`'(B, i), C, S); ev('`'(B, v), C, S)).
ap('|', B, C, S) :-
	!, (C = end_of_file -> ev('`'(B, v), C, S);
	ev('`'(B, '.'(C)), C, S)).
ap('/', B, C, S) :- !,
	(C = end_of_file -> ev('`'(B, v), C, S); ev('`'(B, '?'(C)), C, S)).
ap(e, B, _, _) :- !, ret(B, _, end).

ap(A, _, _, _) :- write('unknown function '), write(A), nl, halt(1).

% START
unl :- parse(E), skip, !, ev(E, end_of_file, end).

:- initialization((unl, halt)).