:- use_module(library(lists)).

/* Operators */

:- op(400,fx,word_expert).
:- op(1150,xfx,:=).
:- op(1100,xfy,o).
:- op(1050,xfy,<-).
:- op(500,xfx,>).
:- op(600,xfy,@).
:- op(700,xfy,&).
:- op(400,fx,add).


/* Word expert compiler */

pwe_compile((word_expert F := Rules),[Clause|Clauses]) :-
    pwe_compile(Rules,F,1,N,Clauses),
    atom_conc(F,N,F1),
    Head =.. [F,P,V], Body =.. [F1,P,V],
    Clause = (Head :- Body),
    format("Compiled PWE ~w/2 from ~w rules.~n",[F,N]).
	
pwe_compile(end,_F,N,N,[]).
pwe_compile((Rule o Rules),F,N0,N,[Clause|Clauses]) :-
    pwe_compile(Rule,F,N0,N1,Clause),
    pwe_compile(Rules,F,N1,N,Clauses).
pwe_compile((_:add A <- Cs),F,N,N,Clause) :-
    atom_conc(F,N,F1),
    Head =.. [F1,P,A],
    compile_conditions(Cs,P,F,N,BodyList,[]),
    list2goal(BodyList,Body),
    Clause = (Head :- Body).
pwe_compile((_:A>B <- Cs),F,N1,N2,Clause) :-
    N2 is N1+1,
    atom_conc(F,N1,F1), atom_conc(F,N2,F2),
    BodyPart1 =.. [F1,P,V0], Head =.. [F2,P,V],
    compile_conditions(Cs,P,F,N1,BodyList,[]),
    list2goal(BodyList,BodyPart2),
    Clause =
        (Head :- 
            BodyPart1, 
            (   V0 == A,
                BodyPart2
            ->  V = B
            ;   V = V0
            )).

compile_conditions((C & Cs),P,F,N) -->
    compile_conditions(C,P,F,N), 
    compile_conditions(Cs,P,F,N).
compile_conditions(FV@Positions,P0,F,N) --> 
    compile_position(Positions,P0,P),
    compile_feature(FV,P,F,N).
compile_conditions({PrologGoal},_P0,_F,_N) --> [PrologGoal].

compile_position([0],P,P) --> !, [].
compile_position([Offset],P0,P) --> !,
    [P is P0+Offset].
compile_position(Positions,P0,P) --> 
    [member(Offset,Positions), P is P0+Offset].

compile_feature(F:A,P,F,N) --> !,
    {atom_conc(F,N,F1),
    Goal =.. [F1,P,A]},[Goal].
compile_feature(F:A,P,_F,_N) --> 
    {Goal =.. [F,P,A]},[Goal].


/* The term expansion stuff*/

term_expansion(Rules,Clauses) :-
    pwe_compile(Rules,Clauses).
    
    
    
/* Utilities */

atom_conc(Atom1,Atom2,Atom) :-
    name(Atom1,L1),
    name(Atom2,L2),
    append(L1,L2,L3),
    name(Atom,L3).

list2goal([X],X) :- !.
list2goal([X|Xs],(X,Ys)) :-
    list2goal(Xs,Ys).