% -----------------------------------------------------------------------------
%  (C) Altran Praxis Limited
% -----------------------------------------------------------------------------
% 
%  The SPARK toolset is free software; you can redistribute it and/or modify it
%  under terms of the GNU General Public License as published by the Free
%  Software Foundation; either version 3, or (at your option) any later
%  version. The SPARK toolset is distributed in the hope that it will be
%  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
%  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
%  Public License for more details. You should have received a copy of the GNU
%  General Public License distributed with the SPARK toolset; see file
%  COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
%  the license.
% 
% =============================================================================


/*** INFER(F) - try to show F follows directly from current hypotheses ***/

infer(A) :- var(A), !, fail.
infer(A) :-
        (
           simplify_in_infer(on),
           simplify(A, B),
           !,
           (
              see_if_can_infer(B)
           ;
              A \= B,
              see_if_can_infer(A)
           ;
              standardise_in_infer(on),
              norm_typed_expr(A, boolean, C),
              see_if_can_infer(C)
           )
        ;
           see_if_can_infer(A)
        ;
           standardise_in_infer(on),
           norm_typed_expr(A, boolean, B),
           A \= B,
           see_if_can_infer(B)
        ), !.


see_if_can_infer(X) :-
        could_infer(X),
        !.
see_if_can_infer(X) :-
        could_not_infer(X),
        !,
        fail.
see_if_can_infer(X) :-
        do_infer(X),
        assertz(could_infer(X)),
        !.
see_if_can_infer(X) :-
        assertz(could_not_infer(X)),
        !,
        fail.

% Initialise.
% The dynamic 'used/1' predicate is central to the operation of the
% 'testused/1' predicate, which is exploited by some portions of
% 'do_infer/1'.  The 'used/1' predicate records when properties have been
% explored during a portion of reasoning. It should be initialised before
% each new portion of reasoning, to prevent old results undermining the
% proof effort.
do_infer(_) :- retractall(used(_)), fail.

do_infer(A=A) :- !.

do_infer(A<>A) :- !, fail.

do_infer([H1|T1]=[H2|T2]) :- do_infer(H1=H2), do_infer(T1=T2), !.

do_infer([H1|_]<>[H2|_]) :- do_infer(H1<>H2), !.

do_infer([_|T1]<>[_|T2]) :- do_infer(T1<>T2), !.

do_infer([]<>[_|_]) :- !.

do_infer([_|_]<>[]) :- !.

do_infer((set [])<>(set [_|_])) :- !.

do_infer((set [_|_])<>(set [])) :- !.

do_infer(true) :- !.

do_infer(not false) :- !.

do_infer(A) :- hyp(_, A), !.

do_infer(_) :-
    % Discharge VC if auto_infer_from_false is switched on.
    auto_infer_from_false(on),
    hyp(_, false), !.

do_infer(A and B) :- do_infer(A), do_infer(B), !.

do_infer(A or B) :- (do_infer(A) ; do_infer(B)), !.

do_infer(A -> B) :- (do_infer(B) ; do_infer(not A)), !.

do_infer(A <-> B) :- do_infer(A -> B), do_infer(B -> A), !.

do_infer(not not A) :- do_infer(A), !.

do_infer(not A) :- neg(A,B), B\=(not A), do_infer(B), !.

do_infer(A=B) :-
        find_mutual_types(A, B, T),
        try_to_infer((=), A, B, T),
        !.

do_infer(A<>B) :-
        find_mutual_types(A, B, T),
        try_to_infer((<>), A, B, T),
        !.

do_infer(A<=B) :-
        find_mutual_types(A, B, T),
        try_to_infer((<=), A, B, T),
        !.

do_infer(A>=B) :-
        find_mutual_types(A, B, T),
        try_to_infer((>=), A, B, T),
        !.

do_infer(A<B) :-
        find_mutual_types(A, B, T),
        try_to_infer((<), A, B, T),
        !.

do_infer(A>B) :-
        find_mutual_types(A, B, T),
        try_to_infer((>), A, B, T),
        !.

do_infer(E in (set [X|Y])) :- ( do_infer(E=X) ; do_infer(E in (set Y)) ), !.
do_infer(E in X \/ Y) :- ( do_infer(E in X) ; do_infer(E in Y) ), !.
do_infer(E in X /\ Y) :- do_infer(E in X), do_infer(E in Y), !.
do_infer(E in X \ Y) :- do_infer(E in X), do_infer(E not_in Y), !.

do_infer(_E not_in (set [])) :- !.
do_infer(E not_in (set [X|Y])) :- do_infer(E<>X), do_infer(E not_in (set Y)), !.
do_infer(E not_in X \/ Y) :- do_infer(E not_in X), do_infer(E not_in Y), !.
do_infer(E not_in X /\ Y) :- ( do_infer(E not_in X) ; do_infer(E not_in Y) ), !.
do_infer(E not_in X \ Y) :- ( do_infer(E not_in X) ; do_infer(E in Y) ), !.

do_infer(X subset_of Y) :- do_infer(X = Y), !.
do_infer((set []) subset_of _X) :- !.
do_infer(X \ _Y subset_of Z) :- do_infer(X subset_of Z), !.
do_infer(X \ Y subset_of X \ Z) :-
        (
           do_infer(Z subset_of Y)
        ;
           do_infer(X /\ Z subset_of X /\ Y) ), !.
do_infer(X \/ Y subset_of X \/ Z) :- do_infer(Y subset_of Z), !.
do_infer(Y \/ X subset_of Z \/ X) :- do_infer(Y subset_of Z), !.
do_infer(Y \/ X subset_of X \/ Z) :- do_infer(Y subset_of Z), !.
do_infer(X \/ Y subset_of Z \/ X) :- do_infer(Y subset_of Z), !.
do_infer(X /\ Y subset_of X /\ Z) :- do_infer(Y subset_of Z), !.
do_infer(Y /\ X subset_of Z /\ X) :- do_infer(Y subset_of Z), !.
do_infer(Y /\ X subset_of X /\ Z) :- do_infer(Y subset_of Z), !.
do_infer(X /\ Y subset_of Z /\ X) :- do_infer(Y subset_of Z), !.
do_infer(X /\ Y subset_of X \/ Y) :- !.
do_infer(Y /\ X subset_of X \/ Y) :- !.
do_infer(X subset_of Y \/ Z) :-
        (
           do_infer(X subset_of Y)
        ;
           do_infer(X subset_of Z)
        ), !.
do_infer(X subset_of Y /\ Z) :-
        do_infer(X subset_of Y),
        do_infer(X subset_of Z),
        !.
do_infer(X /\ Y subset_of Z) :-
        (
           do_infer(X subset_of Z)
        ;
           do_infer(Y subset_of Z)
        ), !.
do_infer((set X) subset_of (set Y)) :- is_subset_of(X, Y), !.

do_infer((set []) strict_subset_of X) :- set_infrule(_E in X), !.
do_infer(X \ Y strict_subset_of Z) :-                           /* CFR012 */
        (
           do_infer(X strict_subset_of Z)
        ;
           do_infer(X subset_of Z),
           set_infer(Y /\ Z <> (set []))
        ), !.
do_infer(X /\ Y strict_subset_of Z) :-
        (
           do_infer(X strict_subset_of Z)
        ;
           do_infer(Y strict_subset_of Z)
        ), !.
do_infer(X strict_subset_of Y \/ Z) :-
        (
           do_infer(X strict_subset_of Y)
        ;
           do_infer(X strict_subset_of Z)
        ), !.
do_infer((set X) strict_subset_of (set Y)) :-
        is_strict_subset_of(X, Y),
        !.

do_infer(first([H|_T]) = X) :- do_infer(H=X), !.
do_infer(first([H|_T] @ _Z) = X) :- do_infer(H=X), !.
do_infer(last([H|T]) = X) :- last([H|T],L), do_infer(L=X), !.
do_infer(last(_F @ [H|T]) = X) :- last([H|T],L), do_infer(L=X), !.


try_to_infer(RO, A, B, TYPE) :-
        GOAL =.. [RO, A, B],
        (
           type(TYPE, set(_)),
           !,
           set_infer(GOAL)
        ;
           type(TYPE, sequence(_)),
           !,
           sequence_infer(GOAL)
        ;
           type(TYPE, enumerated),
           enumeration(TYPE, ENUMLIST),
           !,
           enumerated_infer(GOAL, ENUMLIST)
        ;
           retractall(used(_)),
           !,
           deduce(GOAL, TYPE)
        ),
        !.


/*** INTEXP(E) - succeeds if E is a nice integers-only expression ***/
intexp(A) :- var(A), !, fail.
intexp(A) :- integer(A), !.
intexp(-A) :- intexp(A), !.
intexp(A+B) :- intexp(A), intexp(B), !.
intexp(A-B) :- intexp(A), intexp(B), !.
intexp(A*B) :- intexp(A), intexp(B), !.
intexp(A div B) :- intexp(A), intexp(B), !.
/*** intexp(A mod B) :- intexp(A), intexp(B), !.  TEMPORARILY DELETED ***/


/*** SET_INFER(X R Y) - set strategies ***/
set_infer(_X /\ (set []) = (set [])) :- !.
set_infer((set []) = _X /\ (set [])) :- !.
set_infer((set []) /\ _X = (set [])) :- !.
set_infer((set []) = (set []) /\ _X) :- !.
set_infer(X /\ X = X) :- !.
set_infer(X = X /\ X) :- !.
set_infer(X /\ Y = Y /\ X) :- !.
set_infer(X \/ (set []) = X) :- !.
set_infer(X = X \/ (set [])) :- !.
set_infer((set []) \/ X = X) :- !.
set_infer(X = (set []) \/ X) :- !.
set_infer(X \/ X = X) :- !.
set_infer(X = X \/ X) :- !.
set_infer(X \/ Y = Y \/ X) :- !.
set_infer(X \ (set []) = X) :- !.
set_infer(X = X \ (set [])) :- !.
set_infer((set []) \ _X = (set [])) :- !.
set_infer((set []) = (set []) \ _X) :- !.
set_infer(X \ X = (set [])) :- !.
set_infer(X=Y) :-
        (
           X=Y
        ;
           set_infrule(X=Y)
        ;
           set_infrule(X subset_of Y),
           set_infrule(Y subset_of X)
        ), !.

set_infer((set [_X|_Y]) <> (set [])) :- !.
set_infer((set []) <> (set [_X|_Y])) :- !.
set_infer(X <> (set [])) :- set_infrule(_E in X), !.
set_infer((set []) <> X) :- set_infrule(_E in X), !.
set_infer(X <> Y) :- set_infrule(X <> Y), !.

set_infrule(X) :- fact(X).
set_infrule(X=Y) :- fact(X=Z), testused(X=Z), set_infrule(Y=Z).
set_infrule(X<>Y) :- fact(X=Z), testused(X=Z), set_infrule(Z<>Y).
set_infrule(X<>Y) :- fact(X<>Z), set_infrule(Z=Y).
set_infrule(X<>Y) :- fact(Y<>Z), set_infrule(X=Z).
set_infrule(X in Y) :-
        (
           fact(not (X not_in Y))
        ;
           fact(X=Z),
           testused(X=Z),
           set_infrule(Z in Y)
        ;
           fact(Y=Z),
           testused(Y=Z),
           set_infrule(X in Z)
        ).
set_infrule(X not_in Y) :-
        (
           fact(not (X in Y))
        ;
           fact(X=Z),
           testused(X=Z),
           set_infrule(Z not_in Y)
        ;
           fact(Y=Z),
           testused(Y=Z),
           set_infrule(X not_in Z)
        ).


sequence_infer(X = []) :- do_infer(length(X)=0), !.
sequence_infer([] = X) :- do_infer(length(X)=0), !.
sequence_infer(X @ Y = []) :- sequence_infer(X=[]), sequence_infer(Y=[]), !.
sequence_infer([] = X @ Y) :- sequence_infer(X=[]), sequence_infer(Y=[]), !.
sequence_infer(X @ [] = X) :- !.
sequence_infer([] @ X = X) :- !.
sequence_infer(X = X @ []) :- !.
sequence_infer(X = [] @ X) :- !.
sequence_infer([X|XT]=[Y|YT]) :- do_infer(X=Y), sequence_infer(XT=YT), !.
sequence_infer(first(X) @ nonfirst(X) = X) :- !.
sequence_infer(X = first(X) @ nonfirst(X)) :- !.
sequence_infer(nonlast(X) @ last(X) = X) :- !.
sequence_infer(X = nonlast(X) @ last(X)) :- !.
sequence_infer(nonfirst([_H|T]) = X) :- do_infer(T=X), !.
sequence_infer(nonlast([H|T]) = X) :- append(N, [_L], [H|T]), do_infer(N=X), !.
sequence_infer(X1 @ Y1 = X2 @ Y2) :- do_infer(X1=X2), do_infer(Y1=Y2), !.
sequence_infer(X=Y) :-
        (
           X=Y
        ;
           sequence_infrule(X=Y)
        ), !.

sequence_infer([_|_] <> []) :- !.
sequence_infer([] <> [_|_]) :- !.
sequence_infer([X|_XT] <> [Y|_YT]) :- do_infer(X<>Y), !.
sequence_infer([_X|XT] <> [_Y|YT]) :- sequence_infer(XT<>YT), !.
sequence_infer(X @ Y <> []) :-
        (
           sequence_infer(X <> [])
        ;
           sequence_infer(Y <> [])
        ), !.
sequence_infer(X @ Y <> X) :- sequence_infer(Y <> []), !.
sequence_infer(X @ Y <> Y) :- sequence_infer(X <> []), !.
sequence_infer(X @ Y <> X @ Z) :- sequence_infer(Y <> Z), !.
sequence_infer(X @ Y <> Z @ Y) :- sequence_infer(X <> Z), !.
sequence_infer(X <> Y) :- sequence_infrule(X <> Y), !.


sequence_infrule(X) :- fact(X).
sequence_infrule(X=Y) :- fact(X=Z), testused(X=Z), sequence_infrule(Y=Z).
sequence_infrule(X<>Y) :- fact(X=Z), testused(X=Z), sequence_infrule(Z<>Y).
sequence_infrule(X<>Y) :- fact(X<>Z), sequence_infrule(Z=Y).
sequence_infrule(X<>Y) :- fact(Y<>Z), sequence_infrule(X=Z).


enumerated_infer(X, L) :-
        enum_infrule(X, L),
        !.


enum_infrule(X, _) :- fact(X).
enum_infrule(X=Y, L) :-
        (
           fact(X=Z),
           testused(X=Z),
           enum_infrule(Z=Y, L)
        ;
           testused(Y<=X),
           enum_infrule(Y<=X, L),
           testused(X<=Y),
           enum_infrule(X<=Y, L)
        ).
enum_infrule(X<=Y, L) :-
        (
           enum_infrule(X=Y, L)
        ;
           enum_infrule(X<Y, L)
        ;
           append(_, [X|T], L),
           is_in(Y, T)
        ;
           (
              fact(X<=Z),
              testused(X<=Z)
           ;
              fact(X=Z),
              testused(X=Z)
           ;
              fact(X<Z)
           ),
           enum_infrule(Z<=Y, L)
        ).
enum_infrule(X>=Y, L) :- enum_infrule(Y<=X, L).
enum_infrule(X<Y, L) :-
        (
           fact(X<Z),
           enum_infrule(Z<=Y, L)
        ;
           fact(Z<Y),
           enum_infrule(X<=Z, L)
        ;
           fact(X=Z),
           testused(X=Z),
           enum_infrule(Z<Y, L)
        ;
           append(_, [X|T], L),
           is_in(Y, T)                  /* !!! */
        ).
enum_infrule(X>Y, L) :- enum_infrule(Y<X, L).
enum_infrule(X<>Y, L) :-
        (
           is_in(X, L),
           is_in(Y, L),
           X\=Y
        ;
           enum_infrule(X<Y, L)
        ;
           enum_infrule(Y<X, L)
        ;
           fact(X=Z),
           testused(X=Z),
           enum_infrule(Z<>Y, L)
        ;
           fact(Y=Z),
           testused(Y=Z),
           enum_infrule(X<>Z, L)
        ).


find_mutual_types(A, B, T) :-
        checktype(A, T),
        checktype(B, T),
        !.
%###############################################################################
%END-OF-FILE
