/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   Interpreter for AL(Z) programs.
   Written June 4th 2006 Markus Triska triska@gmx.at
   Public domain code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- use_module(library(assoc)).

:- pce_autoload(finder, library(find_file)).
:- pce_global(@finder, new(finder)).

display_program([], _, _) :- nl.
display_program([L|Ls], N, Current) :-
    (	N =:= Current ->
	format(" ==>  ~s\n", [L])
    ;	format("      ~s\n", [L])
    ),
    N1 is N + 1,
    display_program(Ls, N1, Current).

interpret(step, Stmts, Prog, Env0, Env) :- step(Stmts, Prog, [], Env0, Env).
interpret(run, Stmts, Prog, Env0, Env)	:- run(Stmts, Prog, Env0, Env).

step([], _, _, Env, Env).
step([S|Ss], Prog, Undo0, Env0, Env) :-
    unfold_seqs([S|Ss], [S1|Ss1]),
    question(Prog, S1, Env0, Choice),
    (	Choice = (0'c) ->
	S1 = stm(Line,Stm),
	step(Stm, Line, Ss1, Rest, Env0, Env1),
	step(Rest, Prog, [[S|Ss]-Env0|Undo0], Env1, Env)
    ;	Choice = (0'u) ->
	(   Undo0 = [Us-UEs|Undo1] ->
	    step(Us, Prog, Undo1, UEs, Env)
	;   format("\nnothing to undo\n\n"),
	    step([S1|Ss1], Prog, Undo0, Env0, Env)
	)
    ;	Choice = (0'q) ->
	halt
    ;	Choice = (0'r) ->
	run([S1|Ss1], Prog, Env0, Env)
    ;	format("invalid choice\n\n"),
	run([S1|Ss1], Prog, Undo0, Env0, Env)
    ).

run([], _, Env, Env).
run([S|Ss], Prog, Env0, Env) :-
    Prog = prog(Lines,Displace),
    unfold_seqs([S|Ss], [S1|Ss1]),
    S1 = stm(Line,Stm),
    Offset is Line - Displace,
    display_program(Lines, 0, Offset),
    print_env(Env0),
    format("----------------------------------------------------------------------\n"),
    nl, nl, nl,
    step(Stm, Line, Ss1, Rest, Env0, Env1),
    run(Rest, Prog, Env1, Env).


unfold_seqs([S|Ss], Exps) :-
    (	S = stm(_,sequence(A,B)) ->
	Exps1 = [A,B|Ss],
	unfold_seqs(Exps1, Exps)
    ;	Exps = [S|Ss]
    ).

question(prog(Lines,Displace), stm(Current,_), Env0, Choice) :-
    Offset is Current - Displace,
    display_program(Lines, 0, Offset),
    print_env(Env0),
    format("----------------------------------------------------------------------\n"),
    format("(c)ontinue/(u)ndo/(r)un/(q)uit: "),
    get_single_char(Choice),
    nl,
    format("----------------------------------------------------------------------\n").


step(if(Cond,Then,Else), _, Rest, [Next|Rest], Env, Env) :-
    eval(Cond, Env, Value),
    (	Value =\= 0 ->
	Next = Then
    ;	Next = Else
    ).
step(assign(Var, Expr), _, Rest, Rest, Env0, Env) :-
    eval(Expr, Env0, Value),
    env_put_var(Var, Value, Env0, Env).
step(while(Cond, Body), Line, Rest0, Rest, Env, Env) :-
    eval(Cond, Env, Value),
    (	Value =\= 0 ->
	Rest = [Body,stm(Line,while(Cond,Body))|Rest0]
    ;	Rest = Rest0
    ).


eval(bin(Op,A,B), Env, Value) :-
    eval(A, Env, VA),
    eval(B, Env, VB),
    eval_(Op, VA, VB, Value).
eval(v(V), Env, Value) :-
    (	env_get_var(Env, V, Value) ->
	true
    ;	format("\n\nvariable '~w' not in environment.\n\n\n", [V]),
	halt
    ).
eval(n(N), _, N).
eval(uminus(F), Env, Value) :- eval(F, Env, V), Value is -V.


eval_(+, A, B, V)   :- V is A + B.
eval_(-, A, B, V)   :- V is A - B.
eval_(*, A, B, V)   :- V is A * B.
eval_(/, A, B, V)   :- V is A // B.
eval_(=, A, B, V)   :- (A =:= B -> V = 1 ; V = 0).
eval_(>, A, B, V)   :- ( A > B -> V = 1 ; V = 0).
eval_(<, A, B, V)   :- ( A < B -> V = 1 ; V = 0).
eval_(leq, A, B, V) :- ( A =< B -> V = 1 ; V = 0).
eval_(geq, A, B, V) :- ( A >= B -> V = 1 ; V = 0).
eval_(neq, A, B, V) :- ( A =\= B -> V = 1 ; V = 0).
eval_(and, A, B, V) :- V is min(A, B).
eval_(or, A, B, V)  :- V is max(A, B).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

env_new(E) :- empty_assoc(E).

env_put_var(Name, Value, Env0, Env) :- put_assoc(Name, Env0, Value, Env).

env_get_var(Env, Name, Value) :- get_assoc(Name, Env, Value).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

lex_analysis(Chars, Tokens) :- phrase(tokens(0,Tokens), Chars).


tokens(N0, Ts) -->
    whitespace,
    tokens(N0, Ts).
tokens(N0, Ts) -->
    newline,
    { N1 is N0 + 1 },
    tokens(N1, Ts).
tokens(N0, [T|Ts]) -->
    tok(T, N0),
    !,				% single solution: longest input match
    tokens(N0, Ts).
tokens(_, []) --> "".


tok(';', _) --> ";".
tok(',', _) --> ",".
tok('(', _) --> "(".
tok(')', _) --> ")".

tok(rop(=), _)	  --> "=".
tok(rop(neq), _)  --> "!=".
tok(t(N,'<-'), N) --> "<-".
tok(rop(leq), _)  --> "<=".
tok(rop(geq), _)  --> ">=".
tok(rop(<), _)	  --> "<".
tok(rop(>), _)	  --> ">".

tok(aop(+), _) --> "+".
tok(aop(-), _) --> "-".

tok(mop(*), _) --> "*".
tok(mop(/), _) --> "/".

tok(lop(and), _) --> "&&".
tok(lop(or), _)	 --> "||".

tok(t(N,ID_or_KW), N) -->
    ident(Cs),
    { name(I, Cs), ( keyword(I) -> ID_or_KW = I ; ID_or_KW = id(I) ) }.
tok(num(N), _) --> number(Cs), { name(N, Cs) }.

ident([C|Cs]) --> letter(C), identr(Cs).

identr([C|Cs]) --> letter(C), identr(Cs).
identr([C|Cs]) --> digit(C), identr(Cs).
identr([])     --> [].

number([C|Cs]) --> digit(C), number(Cs).
number([C])    --> digit(C).

letter(C)  --> [C], { between(0'A, 0'Z, C) ; between(0'a, 0'z, C) }.
digit(C)   --> [C], { between(0'0, 0'9, C) }.
whitespace --> [C], { C =< (0' ), C =\= 10}. % ' for editor
newline	   --> [10].

keyword(K) :- memberchk(K, [if,then,else,begin,end,while,do,'I']).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

syn_analysis(Tokens, Tree, Env) :-
    env_new(Env0),
    phrase(prog(Tree,Env0,Env), Tokens).

prog(Tree, Env0, Env) -->
    [t(_,'I')], ['('], [t(_,id(ID))], [')'], [rop(=)], int_exp(IE),
    { eval(IE, Env0, Value) },
    { env_put_var(ID, Value, Env0, Env1) },
    prog(Tree, Env1, Env).
prog(Tree, Env, Env) --> alz(Tree).

alz(stm(N,assign(Id, E)))  --> [t(_,id(Id))], [t(N,'<-')], exp(E).
alz(stm(N,if(Cond,S1,S2))) -->
    [t(N,if)], cond(Cond), [t(_,then)], alz(S1), [t(_,else)], alz(S2).
alz(stm(N,while(Cond, S))) --> [t(N,while)], cond(Cond), [t(_,do)], alz(S).
alz(stm(N,sequence(A,B)))  --> [t(N,begin)], alz(A), [';'], alz(B), [t(_,end)].

cond(C)	     --> rel(C1), condr(C1, C).
condr(C1, C) --> [lop(and)], cond(C2), condr(bin(and,C1,C2), C).
condr(C1, C) --> [lop(or)], cond(C2), condr(bin(or,C1,C2), C).
condr(E, E)  --> [].

rel(bin(Op,A,B)) --> exp(A), [rop(Op)], exp(B).
rel(C)		 --> ['('], cond(C), [')'].


exp(E)	    --> term(E1), expr(E1, E).
expr(E1, E) --> [aop(Op)], term(E2), expr(bin(Op, E1, E2), E).
expr(E, E)  --> [].

term(E)	     --> factor(E1), termr(E1, E).
termr(E1, E) --> [mop(Op)], factor(E2), termr(bin(Op, E1, E2), E).
termr(E, E)  --> [].

factor(n(N))	  --> [num(N)].
factor(v(Id))	  --> [t(_,id(Id))].
factor(E)	  --> ['('], exp(E), [')'].
factor(uminus(F)) --> [aop(-)], factor(F).


% expression for initial interpretation - no variables allowed

int_exp(E)	--> int_term(E1), int_expr(E1, E).
int_expr(E1, E) --> [aop(Op)], int_term(E2), int_expr(bin(Op, E1, E2), E).
int_expr(E, E)	--> [].

int_term(E)	 --> int_factor(E1), int_termr(E1, E).
int_termr(E1, E) --> [mop(Op)], int_factor(E2), int_termr(bin(Op, E1, E2), E).
int_termr(E, E)	 --> [].

int_factor(n(N))      --> [num(N)].
int_factor(E)	      --> ['('], int_exp(E), [')'].
int_factor(uminus(F)) --> [aop(-)], int_factor(F).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

print_env(Env) :-
    assoc_to_list(Env, Ls),
    format("     "),
    maplist(print_pair, Ls),
    nl.

print_pair(Var-Value) :- format("~w = ~w   ", [Var,Value]).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


lines([], []) :- !.
lines(String0, [Line|Lines]) :-
    line_rest(String0, Line, String1),
    lines(String1, Lines).

line_rest(String0, Line, Rest) :-
    (	nth0(N, String0, 10) ->
	length(Line, N),
	append(Line, [_|Rest], String0)
    ;	Line = String0,
	Rest = []
    ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

read_chars(Stream, Cs) :-
    (	at_end_of_stream(Stream) ->
	Cs = []
    ;	Cs = [C|Rest],
	get_code(Stream, C),
	read_chars(Stream, Rest)
    ).

doit(File, Option) :-
    open(File, read, Stream),
    read_chars(Stream, Chars),
    (	lex_analysis(Chars, Tokens) ->
	% format("\n\ntokens:\n\n~w\n", [Tokens]),
	(   syn_analysis(Tokens, Tree, Env0) ->
	    nl,nl,
	    %format("\nAST:\n\n~w\n", [Tree]),
	    %print_env(Env0),
	    Tree = stm(First,_),
	    lines(Chars, Lines),
	    length(Drop, First),
	    append(Drop, Program, Lines),
	    interpret(Option, [Tree], prog(Program,First), Env0, Env),
	    nl,
	    print_env(Env),
	    nl, nl
	;   format("syntax error\n")
	),
	halt
    ;	format("lexical error"),
	halt
    ).

run :-
    (	get(@finder, file, open, *, File) ->
	doit(File, run)
    ;	halt
    ).

step :-
    (	get(@finder, file, open, *, File) ->
	doit(File, step)
    ;	halt
    ).


step(File) :- doit(File, step).

run(File) :- doit(File, run).