%% Son Tran's translator program - b2s.pl
%%
%% input:  a Prolog program representing a domain 
%%         description in Language B with sensing 
%%         actions
%% output: a domain description and a domain problem 
%%	   which will be used as input to Smodels
%%
%% The b2s translator is currently capable of handling
%% the following features:
%%	
%% a. Dynamic Causal Laws of the form:
%%    causes(A,F,P) iff action A causes fluent literal F 
%%		        to be true if preconditions P hold.
%%
%& b. Static Causal Laws:
%%    caused(F,G) iff set of fluent literals G causes fluent  
%%	              literal F to be true.
%%    to be backward compatible with older specifications, we
%%    accept also causes(F,G) as format
%%
%% c. Executability conditions:
%%    executable(A,G) - A can be executed iff G holds
%%
%% d. Sensing actions:
%%    determines(A,L) - A determines the value of fluents in the list L
%%    
%%    Initial state:
%%    initially(F) iff fluent literal F holds in the initial state.  
%%
%% e. Goal state:
%%    goal(F) iff fluent literal F holds in the final state.
%%
%% Notice that b2s will only work correctly if the following
%% predicates are defined in the domain description input file:
%% 1. fluent(F) iff F is a fluent.
%% 2. action(A) iff A is an action.
%%

:- use_module(library(lists)).
:- use_module(library(system)).

:- dynamic 
      noninertial/1,
      caused/2,
      determines/2.

unknown_predicate_handler(_,_,fail).
% this flad is used for swi prolog
%set_prolog_flag(unknown,fail).

%%%
%%% Collecting the fluents and actions names
%%% and repeating them in the output file
%%%

pr_generals(Id) :-
	findall(X, fluent(X), L),
	findall(Y, action(Y), L1),
        findall(Z, noninertial(Z), L2),
	nl(Id),
	write(Id,'%%% Fluents %%%%'),
        nl(Id), nl(Id),
	pr_fluents(L,Id), nl(Id),nl(Id),
        write(Id,'% non-inertial literals'), nl(Id),
        pr_noninertials(L2,Id),nl(Id),nl(Id),
	write(Id,'%%% Actions %%%%'),
        nl(Id),nl(Id),
	pr_actions(L1,Id),nl(Id).

pr_fluents([],Id) :-
	nl(Id),write(Id,'%%% End of Fluents %%%'),nl(Id).

pr_fluents([X|Y],Id) :-
	write(Id,fluent(X)),write(Id,'.'),nl(Id),
	pr_fluents(Y,Id).

pr_noninertials([],Id) :- nl(Id).

pr_noninertials([X|Y],Id) :-
        write(Id,noninertial(X)),write(Id,'.'),nl(Id),
        write(Id,noninertial(neg(X))),write(Id,'.'),nl(Id),
        pr_noninertials(Y,Id).

pr_actions([],Id) :-
	nl(Id),write(Id,'%%% End of Actions %%%'),nl(Id).

pr_actions([X|Y],Id) :-
	write(Id,action(X)),write(Id,'.'),nl(Id),
	pr_actions(Y,Id).


%%%
%%% Collecting static causal laws
%%% and translating them into rules suitable for SMODELS
%%%

pr_static_causal(Id):-
        findall((X,Y),caused(X,Y),L),
        nl(Id),  
        write(Id, '%%% Section: static causal laws %%%%'), 
        nl(Id), 
        pr_static_causal(L, Id).

pr_static_causal([], Id):-
        nl(Id),  
        write(Id, '%%% End section: static causal laws %%%%'), nl(Id).

pr_static_causal([(C,L)|T], Id):-
	write(Id,'h('), 
        write(Id,L), write(Id,', T, P):-  time(T), path(P),'),
        pr_causal_list(Id,C),
	nl(Id),
        pr_static_causal(T, Id).

pr_causal_list(Id,[]):- write(Id, '.').
pr_causal_list(Id,[H|T]):-
        write(Id,'\n        h('), 
        write(Id,H), write(Id,', T, P)'),
        length(T, N),
        (N > 0 -> write(Id,', ') | write(Id, '')),
        pr_causal_list(Id,T).

%%%
%%% Collecting dynamic causal laws 
%%% and translating them into rules suitable for SMODELS
%%%

pr_dynamic_causal(Id) :-
        findall((A,X,Y), causes(A,X,Y), Z),
        nl(Id),  
        write(Id, '%%% Section: dynamic causal laws %%%%'), 
        nl(Id),
        pr_dynamic_causal(Z, Id).

pr_dynamic_causal([], Id):-
        nl(Id),  
        write(Id, '%%% End section: dynamic causal laws %%%%'), nl(Id).

pr_dynamic_causal([(A,L,C)|T], Id):-
	write(Id,'h('), 
        write(Id,L), write(Id,', T+1, P):- time(T), path(P), \n        possible('),
        write(Id,A), write(Id,', T, P),'), 
        write(Id,'\n        occ('), write(Id,A), write(Id,',T,P)'), 
        pr_condition_list(Id,C),
	nl(Id),
        pr_dynamic_causal(T, Id).

pr_condition_list(Id,[]):- write(Id, '.').
pr_condition_list(Id,[H|T]):-
        write(Id,', \n        h('), 
        write(Id,H), write(Id,', T, P)'),
        pr_condition_list(Id,T).


%%%
%%% Generating rules for each executability condition
%%%
%%%

pr_impossible(Id):-
        nl(Id), nl(Id),
        write(Id, '%%% Section: Executability Conditions %%'),
        findall((X,Y), executable(X,Y), Z),
        nl(Id),nl(Id),
        pr_item_executable(Z,Id).

pr_item_executable([],Id):-
        nl(Id),  
        write(Id, '%%% End of section: Executability Conditions %%%%'),
        nl(Id).

pr_item_executable([(A,L)|T],Id):-
        write(Id, 'possible('), write(Id, A), write(Id, ', T, P):- time(T),path(P)'),
        pr_condition_list(Id, L), nl(Id),
        pr_item_executable(T, Id).

%%%
%%% Adding the two auxiliary predicates to the domain file
%%%

eq(X,X).
neq(X,Y):- \+ eq(X,Y).

pr_sensing(Id):-
        nl(Id), nl(Id),
        write(Id, '%%% Section: Sensing Actions %%\n'),
        findall((X,Y), determines(X,Y), Z),
        pr_generate_branch(Id),
        nl(Id),nl(Id),
        pr_item_sensing(Z,Id).

pr_generate_branch(Id):-
        findall(A, action(A), Z),
        pr_generate_action_branch(Id, Z),
        pr_generate_action_branch_constraint(Id).

pr_generate_action_branch_constraint(Id):-
    nl(Id),
    write(Id,':- time(T), path(P1), path(P2),'), nl(Id),
    write(Id,'    path(L1), P1 <= P2, L1 <= P2,'), nl(Id),
    write(Id,'    sense(F), sense(G), neq(F,G),'), nl(Id),
    write(Id,'    domain(F,V), domain(G,V1),'), nl(Id),
    write(Id,'    branch(F,V,T,P1,P2),'), nl(Id),
    write(Id,'    branch(G,V,T,L1,P2).'), nl(Id),
    nl(Id),
    write(Id,':- time(T), T > 1,'), nl(Id),
    write(Id,'    path(P1), path(P2), P1 < P2,'), nl(Id),
    write(Id,'    sense(F), domain(F,V),'), nl(Id),
    write(Id,'    branch(F,V,T,P1,P2), used(T,P2).'), nl(Id),
    nl(Id).

pr_generate_action_branch(_, []).

pr_generate_action_branch(Id, [A|T]):-
        findall(X, determines(A,X), Z),
        pr_generate_item_branch(Id, A, Z),
        pr_generate_action_branch(Id, T).

pr_generate_item_branch(Id, A, []).

pr_generate_item_branch(Id, A, Z):-
        pr_list_sensing_fluent(Id, Z),
        pr_list_sensing_branch(Id, A, Z, 0).

pr_list_sensing_fluent(_, []).

pr_list_sensing_fluent(Id, [F|T]):-
        write(Id, 'sense('), write(Id, F), write(Id, ').\n'),
        pr_list_sensing_fluent(Id, T).

pr_list_sensing_branch(_, _, [], _).

pr_list_sensing_branch(Id, A, [F|T], 0):-
        write(Id, 'branch('), write(Id, F), write(Id, ', T, P, P):-\n'),
        write(Id, '        time(T), path(P), possible('), write(Id, A), 
        write(Id, ', T, P), occ('), write(Id, A), 
        write(Id, ', T, P).\n\n'), 
        pr_list_sensing_branch(Id, A, T, 1).

pr_list_sensing_branch(Id, A, [F|T], 1):-
        write(Id, '1{branch('), write(Id, F), write(Id, ', T, P, P1):new_branch(P, P1)}1:-\n'),
        write(Id, '        time(T), path(P), possible('), write(Id, A), 
        write(Id, ', T, P), occ('), write(Id, A), 
        write(Id, ', T, P).\n'), 
        pr_list_sensing_branch(Id, A, T, 1).


pr_item_sensing([],Id):-
        nl(Id),  
        write(Id, '%%% End of section: Sensing Actions %%%%'),
        nl(Id).

pr_item_sensing([(A,L)|T],Id):-
        write(Id, 'determines('), write(Id, A), write(Id, ', '),
        write(Id, L), write(Id, ').\n'),
        pr_item_sensing(T, Id).

pr_initial(Id):-
        nl(Id), nl(Id),
        write(Id, '%%% Section: Initial %%'),
        findall(X, initially(X), Z),
        nl(Id),nl(Id),
        pr_item_initial(Z,Id).

pr_item_initial([],Id):-
        nl(Id),  
        write(Id, '%%% End of section: Initial %%%%'),
        nl(Id).

pr_item_initial([A|T],Id):-
        write(Id, 'h('), write(Id, A), 
        write(Id, ', 1, 1).\n'),
        pr_item_initial(T, Id).


pr_goal(Id):-
        nl(Id), nl(Id),
        write(Id, '%%% Section: Goal %%'),
        findall(X, sgoal(X), Z),
        nl(Id),nl(Id),
        write(Id, 'goal(T, P):-\n         time(T), path(P)'),
        pr_goal_list(Z,Id), 
        write(Id, 'goal(T+1, P):-\n'),
        write(Id, '    time(T), path(P),\n'),
        write(Id, '    goal(T, P).\n\n'),
        write(Id, 'ggoal(P):- path(P), time(T), used(T, P), goal(length, P).\n'),
        write(Id, ':- path(P), used(length, P), not ggoal(P).\n\n%%% End of section: Goal %%%%\n\n').

pr_goal_list([],Id):-
        write(Id, '.\n').

pr_goal_list([A|T],Id):-
        write(Id, ',\n         h('), write(Id, A), 
        write(Id, ', T, P)'),
        pr_goal_list(T, Id).

%%%

pr_ab(Id):-
        nl(Id), nl(Id),
        write(Id, '%%% Section: Abnormality of fluent %%\n\n'),
        write(Id, 'possibly_h(F, T, P):-\n'),
        write(Id, '              literal(F), literal(G),\n'),
        write(Id, '              contrary(F, G),\n'),
        write(Id, '              time(T), path(P),\n'),
        write(Id, '              not h(G, T, P).\n'),
        findall(X, fluent(X), Z),
        nl(Id),nl(Id),
        pr_ab_list(Z,Id).

pr_ab_list([],Id):-
        write(Id, '\nh(F, T+1, P):-\n'),
        write(Id, '              literal(F), \n'),
        write(Id, '              time(T), path(P),\n'),
        write(Id, '              h(F, T, P),\n'),
        write(Id, '              not noninertial(F),\n'),
        write(Id, '              literal(G), contrary(F, G),\n'),
        write(Id, '              not h(G, T+1, P),\n'),
        write(Id, '              not ab(F, T, P).\n\n'),
        write(Id, '%%% End Section: Abnormality of fluent %%\n\n').

pr_ab_list([H|L],Id):-
        pr_ab_item(H,Id),
        pr_ab_list(L,Id).


pr_ab_item(F,Id):-
         findall((A,F,L),causes(A,F,L),Z1),
         pr_ab_item_list(Z1,neg(F),Id),
         findall((A,F,L),causes(A,neg(F),L),Z2),
         pr_ab_item_list(Z2,F,Id).

pr_ab_item_list([],_,_).

pr_ab_item_list([(A,G,S)|L],F,Id):-
        write(Id, '\nab('), write(Id, F), write(Id, ', T, P):- time(T),path(P),'),
        write(Id, '\n          occ('), write(Id, A), write(Id, ', T, P)'),
        length(S, N),
        (N > 0 -> write(Id,', ') | write(Id, '')),
        pr_possible_list(Id,S), 
        pr_ab_item_list(L,F,Id).
        

pr_possible_list(Id,[]):- write(Id,'.\n').
        
pr_possible_list(Id,[H|T]):- 
        write(Id,'\n          possibly_h('), write(Id, H), write(Id, ', T, P)'),
        length(T, N),
        (N > 0 -> write(Id,', ') | write(Id, '')),
        pr_possible_list(Id,T).


pr_auxiliary(Id):-
        write(Id,'%%%%%%%%%%%%Begin auxiliary predicates\n\n'),
        write(Id,'time(1..length).\n'),
        write(Id,'path(1..level).\n'),
        write(Id,'literal(F):- fluent(F).\n'),
        write(Id,'literal(neg(F)):- fluent(F).\n'),
        write(Id,'contrary(F, neg(F)):- fluent(F).\n'),
        write(Id,'contrary(neg(F), F):- fluent(F).\n\n'),
        write(Id,'new_branch(L, L1):-\n'),
        write(Id,'    path(L), path(L1), L < L1.\n'),
        write(Id,'h(F, T+1, P1):-\n'), 
        write(Id,'  	path(P), time(T), path(P1), P <= P1, sense(F),\n'),
        write(Id,'	branch(F, T, P, P1).\n\n'),
        write(Id,'used(T+1, P1):- \n'),
        write(Id,'  	path(P), time(T), path(P1), P <= P1, sense(F),\n'),
        write(Id,'	branch(F, T, P, P1).\n\n'),
        write(Id,':- path(L), time(T), fluent(F), action(A),\n'),
        write(Id,'   determines(A, F), occ(A, T, L),\n'),
        write(Id,'   known(F, T, L).\n\n'),
        write(Id,'h(G, T+1, L1):-\n'),
        write(Id,'    time(T), path(L1), path(L), \n'),
        write(Id,'    literal(G),\n'),
        write(Id,'    sense(F), L <= L1,\n'),
        write(Id,'    branch(F, T, L, L1),\n'),
        write(Id,'    h(G, T, L).\n\n'),
        write(Id,'unknown(F, T, L):-\n'),
        write(Id,'    path(L), time(T), fluent(F),\n'),
        write(Id,'    not known(F, T, L).\n\n'),
        write(Id,'known(F, T, L):-\n'),
        write(Id,'    path(L), time(T), fluent(F),\n'),
        write(Id,'    h(F, T, L).\n\n'),
        write(Id,'known(F, T, L):-\n'),
        write(Id,'    path(L), time(T), fluent(F), contrary(F, G),\n'),
        write(Id,'    h(G, T, L).\n\n'),
        write(Id,'used(1, 1).\n'),
        write(Id,'used(T+1, L):- time(T), path(L), used(T, L).\n\n'),
        write(Id,'1{occ(A, T, P) : action(A)}1:-\n'),
        write(Id,'    time(T),\n'),
        write(Id,'    path(P),\n'),
        write(Id,'    used(T, P),\n'),
        write(Id,'    not goal(T, P).\n\n'),
        write(Id,':-  time(T),  path(P),\n'),
        write(Id,'     used(T, P),  action(A),\n'),
        write(Id,'     occ(A,T,P), not possible(A, T, P).\n'),
        write(Id,'%%%%% End auxiliary section\n\n').

pr_auxiliary1(Id):-
        write(Id, ':-  time(T),  path(P),\n'),
        write(Id,'    literal (P),  literal(G),\n'),
        write(Id,'    contrary(F,G), h(F, T, P), h(G, T, P).\n\n'),
        write(Id,'hide time(T).\n'),
        write(Id,'hide path(L).\n'),
        write(Id,'hide action(A).\n'),
        write(Id,'hide determines(A,F).\n'),
        write(Id,'hide contrary(F,G).\n'),
        write(Id,'hide fluent(F).\n'),
        write(Id,'hide literal(L).\n'),
        write(Id,'hide unknown(F, T, L).\n'),
        write(Id,'hide known(F, T, L).\n'),
        write(Id,'hide used(T, L).\n'),
        write(Id,'hide sense(F).\n'),
        write(Id,'%hide ggoal(L).\n'),
        write(Id,'hide goal(T,L).\n'),
        write(Id,'hide new_branch(L, L1).\n'),
        write(Id,'hide executable(A,S).\n'),
        write(Id,'hide possible(A, T, L).\n'),
        write(Id,'hide ab(F, T, L).\n'),
        write(Id,'hide h(F, T, L).\n'),
        write(Id,'hide noninertial(F).\n'),
        write(Id,'hide possibly_h(F, T, L).\n\n').

gen:-
        write(' Enter domain description file name: '),
     	read(S),
	name(S,Chars),
	name(smo,Chars1),
	append(Chars,[46|Chars1],Chars2),
	name(S1,Chars2),
	absolute_file_name(S, Source), %%% get the source file name
	consult(Source),
	absolute_file_name(S1, FileDescr), %%% get the domain output file name
        write(' Generating .... '),
        open(FileDescr, write , X),
        pr_auxiliary(X),
	write(X,'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n'),
	write(X,'%%%%    Domain Description               %%%%%\n'),
	write(X,'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n'),
        pr_generals(X),
        pr_static_causal(X),
        pr_dynamic_causal(X),
        pr_impossible(X),
        pr_ab(X),
        pr_sensing(X),
        pr_initial(X),
        pr_goal(X),
        pr_auxiliary1(X),
        close(X).