/*  PS_COMPILE.PL  */


/*
:- module ps_compile.
*/


/*
SPECIFICATION
-------------
*/


:- op( 253, xfy, prio ).
:- op( 254, xfx, => ).
:- op( 254, xfx, reduces_to ).
:- op( 10, fx, @ ).
:- op( 20, xfx, :: ).
:- op( 10, fx, resolve ).
:- op( 10, fx, stm ).
:- op( 10, fx, stm_predicates ).
:- op( 10, fx, perceptual_predicates ).
:- op( 254, xfx, ::: ).


/*
IMPLEMENTATION
--------------

I assume that this file will only be used when module ps is loaded.
*/


:- reconsult('$eden_src/useful').
:- reconsult('$eden_src/control').


to_rules( [], [] ) :- !.

to_rules( [Rule1|RulesN], RulesT ) :-
    to_rule( Rule1, Rule1T ),
    to_rules( RulesN, RulesNT ),
    rule_insert( RulesNT, Rule1T, RulesT ).


to_raps( [], [] ) :- !.

to_raps( [Rap1|RapsN], RapsT ) :-
    to_rap( Rap1, Rap1T ),
    to_raps( RapsN, RapsNT ),
    rap_insert( RapsNT, Rap1T, RapsT ).


to_subs( [], [] ) :- !.

to_subs( [Sub1|SubsN], SubsT ) :-
    to_sub( Sub1, Sub1T ),
    to_subs( SubsN, SubsNT ),
    sub_insert( SubsNT, Sub1T, SubsT ).


compile_ps( RulesT, STMT, ResolutionStrategy ) :-
    fast_bagof( (Cond=>Action), (Cond=>Action), Rules ),
    to_rules( Rules, RulesT ),
    (resolve ResolutionStrategy),
    (stm STM),
    list_to_stm( STM, STMT ).


to_raps( RapsT ) :-
    fast_bagof( (G reduces_to Rap), (G reduces_to Rap), Raps ),
    to_raps( Raps, RapsT ).


to_rule( (Cond => Action), RuleT ) :-
    to_condition( Cond, CondT, PrioT ),
    to_action( Action, ActionT ),
    new_rule( RuleT ),
    rule_vs_condition( RuleT, CondT ),
    rule_vs_priority( RuleT, PrioT ),
    rule_vs_action( RuleT, ActionT ).


to_subs( SubT ) :-
    fast_bagof( (Sub:::Rule), (Sub:::Rule), Subs ),
    to_subs( Subs, SubsT ).


to_condition( (PrioT prio Cond), CondT, PrioT ) :-
    !,
    conj_vs_list( Cond, CondL ),
    to_condition_1( CondL, CondT ).

to_condition( Cond, CondT, PrioT ) :-
    to_condition( (0 prio Cond), CondT, PrioT ).


to_condition_1( [], [] ) :- !.

to_condition_1( [H|T], [H1|T1] ) :-
    to_prim_condition( H, H1 ),
    to_condition_1( T, T1 ).


from_stm( @S, '$at'(S) ) :- !.

from_stm( true, true ) :- !.

from_stm( =(A,B), =(A,B) ) :- !.
from_stm( \=(A,B), \=(A,B) ) :- !.
from_stm( >(A,B), >(A,B) ) :- !.
from_stm( >=(A,B), >=(A,B) ) :- !.
from_stm( <(A,B), <(A,B) ) :- !.
from_stm( =<(A,B), =<(A,B) ) :- !.
from_stm( exec(A), exec(A) ) :- !.
from_stm( erase(A), erase(A) ) :- !.

from_stm( S, '$at'(S) ) :-
    stm_predicates( L ),
    functor( S, F, _ ),
    ( L = all ; non_binding_call(member(F,L)) ), !.

from_stm( S, S ) :-
    perceptual_predicates( L ),
    functor( S, F, _ ),
    ( L = all ; non_binding_call(member(F,L)) ), !.

from_stm( S, S ).


to_prim_condition( not(Cond), not(CondT) ) :-
    from_stm( Cond, CondT ),
    !.

to_prim_condition( Cond, CondT ) :-
    from_stm( Cond, CondT ),
    !.


to_action( Action, ActionT ) :-
    conj_vs_list( Action, ActionL ),
    to_action_1( ActionL, ActionT ).


to_action_1( [], [] ) :- !.

to_action_1( [H|T], [H1|T1] ) :-
    to_prim_action( H, H1 ),
    to_action_1( T, T1 ).


to_prim_action( sub(Name), sub(Name) ) :- !.

to_prim_action( Action, ActionT ) :-
    from_stm( Action, ActionT ).


to_rap( (Goal reduces_to Plan), RapT ) :-
    to_prim_condition( Goal, GoalT ),
    to_plan( Plan, GoalT, PlanT ),
    rap_vs_goal( RapT, GoalT ),
    rap_vs_plan( RapT, PlanT ).


to_plan( Plan, GoalT, PlanT ) :-
    conj_vs_list( Plan, PlanL ),
    to_plan_1( PlanL, GoalT, PlanT ).


to_plan_1( [], _, [] ) :- !.

to_plan_1( [H|T], GoalT, [H1|T1] ) :-
    to_prim_plan( H, GoalT, H1 ),
    to_plan_1( T, GoalT, T1 ).


to_prim_plan( (Prec::Plan), GoalT, (PrecT::PlanT) ) :-
    !,
    to_prim_condition( Prec, PrecT ),
    to_prim_plan( Plan, GoalT, PlanT ).

to_prim_plan( (C->A1;A2), GoalT, (CT->A1T;A2T) ) :-
    !,
    to_prim_condition( C, CT ),
    to_prim_plan( A1, GoalT, A1T ),
    to_prim_plan( A2, GoalT, A2T ).

to_prim_plan( [A|B], GoalT, '$rules'(RulesT_) ) :-
    !,
    to_rules( [A|B], RulesT ),
    replace_finish( RulesT, GoalT, RulesT_ ).

to_prim_plan( Plan, _, PlanT ) :-
    from_stm( Plan, PlanT ).


to_sub( Name:::Rule, sub(Name,RuleT) ) :-
    to_rule( Rule, RuleT ).


replace_finish( [], _, [] ) :- !.

replace_finish( [R1|Rn], GoalT, [R1R|RnR] ) :-
    replace_finish_1( R1, GoalT, R1R ),
    replace_finish( Rn, GoalT, RnR ).


replace_finish_1( Rule, GoalT, Rule_ ) :-
    rule_vs_action( Rule, Action ),
    replace_finish_2( Action, GoalT, Action_ ),
    new_rule( Rule_ ),
    rule_vs_action( Rule_, Action_ ),
    rule_vs_condition( Rule, Condition ),
    rule_vs_condition( Rule_, Condition ).


replace_finish_2( [], _, [] ) :- !.

replace_finish_2( [finish|Rest], '$at'(G), [erase(G)|Rest] ).

replace_finish_2( [A1|Rest], GoalT, [A1|Rest_] ) :-
    replace_finish_2( Rest, GoalT, Rest_ ).


/*
:- endmodule.
*/