% Decision procedure for purely ordered logic
% (full Lambek calculus)

% A,B ::= P
%       | A \ B | B / A | A & B | t
%       | A * B | 1 | A + B | 0
%
% O ::= [A1,...,An]

% All operators are non-associative to avoid errors
:- op(850, xfx, \).
:- op(850, xfx, /).
:- op(850, xfx, *).
:- op(850, xfx, &).
:- op(850, xfx, +).

right(O, A \ B) :- append([A], O, O1), right(O1, B).
right(O, B / A) :- append(O, [A], O1), right(O1, B).
right(O, A & B) :- right(O, A), right(O, B).
right(_, t)     :- true.
right(O, A * B) :- append(O1, O2, O), right(O1, A), right(O2, B).
right(O, 1)     :- O = [].
right(O, A + _) :- right(O, A).
right(O, _ + B) :- right(O, B).
% right(O, 0)     :- fail.
right(O, C) :- append(OL, [A|OR], O), left(OL, A, OR, C).

left(OL, A \ B, OR, C) :- append(O1, O2, OL), right(O2, A),
                          append(O1, [B|OR], O), right(O, C).
left(OL, B / A, OR, C) :- append(O1, O2, OR), right(O1, A),
                          append(OL, [B|O2], O), right(O, C).
left(OL, A & _, OR, C) :- append(OL, [A|OR], O), right(O, C).
left(OL, _ & B, OR, C) :- append(OL, [B|OR], O), right(O, C).
% left(OL, t, OR, C)   :- fail.
left(OL, A * B, OR, C) :- append(OL, [A|[B|OR]], O), right(O, C).
left(OL, 1, OR, C)     :- append(OL, OR, O), right(O, C).
left(OL, A + B, OR, C) :- append(OL, [A|OR], O1), right(O1, C),
                          append(OL, [B|OR], O2), right(O2, C).
left(_ , 0, _ , _)     :- true.
left([], C, [], C).

prove(A) :- format(" ==> ~p~n", [A]), fail.
prove(A) :- right([], A).

equiv(A,B) :- format("~p <=> ~p~n", [A,B]), fail.
equiv(A,B) :- right([A], B), right([B], A).