%% prop ::= atomic(p)
%%        | and(A, A)
%%        | or(A, A)
%%        | implies(A, A)
%%        | t
%%        | f

member_(X, [X | _])
:-
  !.

member_(X, [_ | L])
:-
  member_(X, L).


append_([], L, L).

append_([X | L1], L2, [X | L3])
:-
  append_(L1, L2, L3).


%% seqR(atom list, prop list, prop)
%% seqL(atom list, synch prop list, prop list, synch prop)
%% choose(atom list, synch prop list, synch prop)
%% chooseR(atom list, synch prop list, synch prop)
%% chooseL(atom list, synch prop list, synch prop list, synch prop)


%% Right decomposition

seqR(PL, HL, atomic(P))
:-
  seqL(PL, [], HL, atomic(P)).

seqR(PL, HL, and(A, B))
:-
  seqR(PL, HL, A),
  seqR(PL, HL, B).

seqR(PL, HL, or(A, B))
:-
  seqL(PL, [], HL, or(A, B)).

seqR(PL, HL, implies(A, B))
:-
  seqR(PL, [A | HL], B).

seqR(PL, HL, t).

seqR(PL, HL, f)
:-
  seqL(PL, [], HL, f).


%% Left decomposition

seqL(PL, SL, [atomic(P) | HL], C)
:-
  seqL([P | PL], SL, HL, C).

seqL(PL, SL, [and(A, B) | HL], C)
:-
  seqL(PL, SL, [A, B | HL], C).

seqL(PL, SL, [or(A, B) | HL], C)
:-
  seqL(PL, SL, [A | HL], C),
  seqL(PL, SL, [B | HL], C).

seqL(PL, SL, [t | HL], C)
:-
  seqL(PL, SL, HL, C).

seqL(PL, SL, [f | HL], C).

seqL(PL, SL, [implies(atomic(P), B) | HL], C)
:-
  seqL(PL, [implies(atomic(P), B) | SL], HL, C).

seqL(PL, SL, [implies(and(D, E), B) | HL], C)
:-
  seqL(PL, SL, [implies(D, implies(E, B)) | HL], C).

seqL(PL, SL, [implies(or(D, E), B) | HL], C)
:-
  seqL(PL, SL, [implies(D, B), implies(E, B) | HL], C).

seqL(PL, SL, [implies(implies(D, E), B) | HL], C)
:-
  seqL(PL, [implies(implies(D, E), B) | SL], HL, C).

seqL(PL, SL, [implies(t, B) | HL], C)
:-
  seqL(PL, SL, [B | HL], C).

seqL(PL, SL, [implies(f, B) | HL], C)
:-
  seqL(PL, SL, HL, C).

seqL(PL, SL, [], C)
:-
  choose(PL, SL, C).


%% Choice

choose(PL, SL, C)
 :-
  chooseR(PL, SL, C).

choose(PL, SL, C)
:-
  chooseL(PL, SL, [], C).


%% Right choice

chooseR(PL, SL, or(A, B))
:-
  seqR(PL, SL, A).

chooseR(PL, SL, or(A, B))
:-
  seqR(PL, SL, B).

chooseR(PL, SL, atomic(P))
:-
  member(P, PL).

%% chooseR(PL, SL, f) no rule


%% Left choice

chooseL(PL, [implies(atomic(P), B) | SL], RSL, C)
:-
  member(P, PL), 
  !,
  append(SL, RSL, NSL),
  seqL(PL, NSL, [B], C).

chooseL(PL, [implies(implies(D, E), B) | SL], RSL, C)
:-
  append(SL, RSL, NSL),
  seqR(PL, [implies(E, B), D | NSL], E),
  %% maybe cut?
  seqL(PL, NSL, [B], C).

chooseL(PL, [A | SL], RSL, C)
:-
  chooseL(PL, SL, [A | RSL], C).

%% chooseL(PL, [], RSL, C) no rule


%% Top level driver

prove(A)
:-
  seqR([], [], A).