% -----------------------------------------------------------------------------
%  (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.
% 
% =============================================================================

%###############################################################################
% PURPOSE
%-------------------------------------------------------------------------------
% Top level simplification, ordering calls to the various simplification
% routines declared elsewhere.
%###############################################################################

%###############################################################################
% MODULE
%###############################################################################

%###############################################################################
% DEPENDENCIES
%###############################################################################

%###############################################################################
% TYPES
%###############################################################################

%###############################################################################
% DATA
%###############################################################################

%###############################################################################
% PREDICATES
%###############################################################################

% A. CONTRADICTION-HUNTER
%
% Store traversal conditions (rather like hypotheses).
%
% Each has
%         get_hyp(FORMULA,  x,     N)          -- after "simplification"
%         get_hyp(STD_FORM, [s,T], N)          -- full standard form (with mods.)
%         get_hyp(SS_FORM,  ss,    N)          -- semi-standard form (XrY --> X'rY').
%
% On reading hypotheses from file, negin, and-splitting and simplification should
% be performed automatically before proceeding further.
%
% Look for contradictions thus:
%
%         [Assume:        know(X) :- hyp ; sf ; ssf ; inferred(X).        ]
%
% (1)  See if know "false".
%
% (2)  For each known P, see if (not P)', sf(not P), ssf(not P) known.
%
% (3)  See if can infer empty-range, e.g. for all X in A..B, that A>B (in other
%      words, a "contradictory pair", e.g. x>3 and x<0).
%
% (4)  Perform forward-inferences and standardise to form additional sf facts
%      [must keep pointers to hypotheses used].
%
% (5)  Perform equality (and equivalence) substitutions to generate new facts and
%      try standardising these to see if a contradiction can be established.
%
%
% B. EXPRESSION-REDUCTION
%
% [Only necessary if contradiction-hunt proves fruitless.]
%
% (1)  If any hyp's or sf's are true, corresponding hypotheses can be eliminated.
%
% (2)  If any range-subsumptions (e.g. x>0, x>1: latter superfluous), subsumed
%      hypothesis can be eliminated.
%
% (3)  If any "complementary pair" disjunctions (e.g. x>0 or x<3), these can be
%      eliminated.
%
% (4)  If any implication hypotheses, try satisfying l.h.s.: success allows
%      hypothesis to be reduced to its consequent.
%
% (5)  If any equivalences, work on satisfy each side in turn: if either is
%      satisfiable, replace equivalence by other side; if either reduces (via
%      simple strategy) to false, replace by negated other side.
%
% (6)  Form joins to depth 2 (?) of all relational expressions with a standard
%      form.  For each in turn, see if its negation further joined to a depth of
%      two gives a contradiction; if so, the hypothesis itself is redundant and
%      may be eliminated.  (If any joins of actual hypotheses yield "false",
%      contradiction has been established subsequent to contradiction-hunt.)

simplify_vc :-
    do_simplify_vc,
    !.
simplify_vc :-
    !.

%-------------------------------------------------------------------------------

do_simplify_vc :-
    clear_up_old_facts,
    % see if all conclusions proved.
    try_to_prove_concs,
    proved_all_conclusions,
    !.

do_simplify_vc :-
    issue_message('Rule substitutions phase 1', []),
    do_rule_substitutions1, % Look for things in Concs that need substituting
    try_to_prove_concs,     % see if all conclusions proved
    proved_all_conclusions,
    !.

do_simplify_vc :-
    restructure_vc(toplevel),       % move negation inwards, etc.
    issue_message('Rule substitutions phase 2', []),
    do_rule_substitutions2, % e.g. if rule C = 10, replace C by 10
    form_instantiable_hyp_facts,
    issue_message('Standardise hypotheses', []),
    setup_hypotheses,       % create standard & semi-standard forms
    issue_message('Standardise conclusions', []),
    setup_conclusions,      % create standard & semi-standard forms
    try_to_prove_concs,     % see if any conclusions proved
    proved_all_conclusions, % and stop if all proved
    !.

do_simplify_vc :-
    contradiction_hunt,     % look for contradictions
    issue_message('Expression reduction', []),
    expression_reduction,   % get rid of redundant hypotheses
    form_instantiable_hyp_facts, % expression_reduction might have changed
                                 % hypotheses, so re-generate instantiable hyp facts
    asserta(allow_new_strategies),  % use extra rules in inference engine
    try_to_prove_concs,     % see if any more conclusions proved
    proved_all_conclusions, % and stop if all proved
    !.

do_simplify_vc :-
    found_contradiction,    % stop if so
    !.

do_simplify_vc :-
    restructure_vc(toplevel),       % Restructure prior to proof-framing
    extended_simplify,      % eliminate redundant modulus operators etc.
    try_to_prove_concs,     % eliminate any obvious ones, post-restructuring
    proved_all_conclusions, % and stop if all proved
    !.

do_simplify_vc :-
    issue_message('Adding hypotheses from ground inference rules', []),
    find_max_hyp_no(_MAX),
    add_hypotheses_from_ground_inference_rules,
    try_to_prove_concs,     % See if all conclusions have been proved.
    proved_all_conclusions,
    !.

do_simplify_vc :-
    issue_message('Proof framing', []),
    try_proof_framing,      % Try unwrapping, implication, proof by cases.
    fail.

do_simplify_vc :-
    user_rule_exists(_,_),  % If so, try using them
    issue_message('Applying proof rules', []),
    apply_user_defined_proof_rules,
    !.

do_simplify_vc :-
    !.            % otherwise, succeed anyway

%-------------------------------------------------------------------------------

clear_up_old_facts :-
    retractall(complexity_fact(_, _, _, _)),
    prune_all_hyps(_, [s|_], _),
    prune_all_hyps(_, ss, _),
    prune_all_concs(_, [s|_], _),
    prune_all_concs(_, ss, _),
    retractall(join_hyp(_, _, _, _)),
    prune_all_subst_hyp(_, _, _),
    prune_all_forall_hyp,
    retractall(found_contradiction),
    retractall(know_eliminated(_)),
    retractall(know_eliminated_in_subgoaling(_,_)),
    prune_all_processed_hyp_with_field_op,
    prune_all_processed_hyp_with_field_op_in_subgoal,
    retractall(know_substituted(_)),
    prune_all_proved_concs,
    retractall(know_norm_expr(_, _)),
    retractall(issued_contradiction_message),
    retractall(issued_vc_proved_message),
    retractall(allow_new_strategies),
    retractall(known_upper_numeric_limit(_,_,_,_)),
    retractall(known_lower_numeric_limit(_,_,_,_)),
    retractall(candidate_upper(_,_,_,_)),
    retractall(candidate_lower(_,_,_,_)),
    retractall(proved_by_user_rules),
    fail.

clear_up_old_facts :- !.

%-------------------------------------------------------------------------------

add_hypotheses_from_ground_inference_rules :-

    inference_rule(_File:_Name, Rule, []),
    ground(Rule),
    simplify(Rule, SimpRule),
    maybe_add_new_hyp(SimpRule),
    fail.
add_hypotheses_from_ground_inference_rules :-
    !.

%-------------------------------------------------------------------------------

% If a new hyp simplifies to 'true', then ignore it
maybe_add_new_hyp(true) :-
    !.

% Otherwise, add it and a log fact
maybe_add_new_hyp(Rule) :-
    add_hyp(Rule, x, NewNo),
    assert_log_fact(new_hyp, [NewNo, Rule, toplevel]).

%-------------------------------------------------------------------------------

setup_hypotheses :-
    \+ get_hyp(_,_,_),
    asserta(max_hyp_no(0)),
    find_max_conc_no,
    !.
setup_hypotheses :-
    (
        get_hyp(A<=B, _, M)
    ;
        get_hyp(B>=A, _, M)
    ),
    (
        get_hyp(A>=B, _, N)
    ;
        get_hyp(B<=A, _, N)
    ),
    do_replace_hyps(M, N, A=B),
    fail.


setup_hypotheses :-
    (
        get_hyp(A<=B, _, M)
    ;
        get_hyp(B>=A, _, M)
    ),
    (
        get_hyp(A<>B, _, N)
    ;
        get_hyp(B<>A, _, N)
    ),
    do_replace_hyps(M, N, A<B),
    fail.

setup_hypotheses :-
    find_max_hyp_no(MAX),
    find_max_conc_no,
    retractall(hn(_)),
    asserta(hn(1)),
    repeat,
       fetch_next_hn(N),
       stan_and_semi_stan(N),
       % until
       N = MAX,
    !.

%-------------------------------------------------------------------------------

setup_conclusions :-
    max_conc_no(MAX),
    retractall(hn(_)),
    asserta(hn(1)),
    repeat,
    fetch_next_hn(N),
    stan_and_semi_stan_conc(N),
        % until
        N = MAX,
    !.

%-------------------------------------------------------------------------------


do_replace_hyps(M, N, Formula) :-
    prune_hyp(_, _, M),
    prune_hyp(_, _, N),
    !,
    add_hyp(Formula, x, NewNo),
    assert_log_fact(combined_hyps, [M, N, NewNo, Formula]),
    !.

%-------------------------------------------------------------------------------

find_max_hyp_no(MAX) :-
    retractall(max_hyp_no(_)),
    get_hyp(_, x, MAX),
    \+ (get_hyp(_, x, X), X > MAX),
    !,
    asserta(max_hyp_no(MAX)),
    !.

find_max_hyp_no(_MAX) :-
    asserta(max_hyp_no(0)),
    !.

find_max_conc_no :-
    retractall(max_conc_no(_)),
    get_conc(_, x, MAX),
    \+ (get_conc(_, x, X), X > MAX),
    !,
    asserta(max_conc_no(MAX)),
    !.
find_max_conc_no :-
    asserta(max_conc_no(0)),
    !.

%-------------------------------------------------------------------------------

fetch_next_hn(N) :-
    hn(N),
    !,
    retractall(hn(_)),
    NEXT_N is N + 1,
    asserta(hn(NEXT_N)),
    !.

%-------------------------------------------------------------------------------

stan_and_semi_stan(N) :-
    complexity_limit(LIM),
    get_hyp(FORMULA, x, N),
    (
        simplification_is_on,
        simplify(FORMULA, HYP),
       (
          FORMULA \= HYP,
          replace_hyp(_Old_Hyp, x, N, HYP),
          assert_log_fact(further_simplified, [hyp, N, FORMULA, HYP])
       ;
          true
       )
    ;
       HYP = FORMULA
    ),
    !,
    complexity(HYP, N, hyp, x, CX),
    !,
    (
       CX < LIM,
       stan(HYP, N, hyp),
       maybe_semi_stan(HYP, N, hyp)

    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

% Don't bother standardising conclusions already proved.
stan_and_semi_stan_conc(N) :-
    get_proved_conc(N),
    !.

stan_and_semi_stan_conc(N) :-
    complexity_limit(LIM),
    get_conc(FORMULA, x, N),
    (
       simplification_is_on,
       simplify(FORMULA, CONC),
       (
          FORMULA \= CONC,
          replace_conc(_, x, N, CONC),
          assert_log_fact(further_simplified, [conc, N, FORMULA, CONC])
       ;
          true
       )
    ;
       CONC = FORMULA
    ),
    !,
    complexity(CONC, N, conc, x, CX),
    !,
    (
       CX < LIM,
       stan(CONC, N, conc),
       maybe_semi_stan(CONC, N, conc)
    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

complexity(FORMULA, N, HorC, XXX, COMPLEXITY) :-
    has_complexity(FORMULA, COMPLEXITY),
    save_complexity(HorC, N, XXX, COMPLEXITY),
    !.

%-------------------------------------------------------------------------------

has_complexity(ATOM, 0) :-
    atomic(ATOM),
    !.

has_complexity(F_ARGS, N) :-
    nonvar(F_ARGS),
    !,
    F_ARGS =.. [_F|ARGS],
    have_complexity(ARGS, C),
    N is C + 1.

have_complexity([X], N) :-
    !,
    has_complexity(X, N).

have_complexity([X|REST], N) :-
    has_complexity(X, XC),
    !,
    have_complexity(REST, RC),
    !,
    N is XC + RC.

%-------------------------------------------------------------------------------

stan(FORMULA, N, HorC) :-
    standardisation_is_on,
    !,
    norm_typed_expr(FORMULA, boolean, NEWFORM),
    !,
    complexity(NEWFORM, N, HorC, s, _),
    save_stan_fact(NEWFORM, N, HorC),
    !.

stan(_FORMULA, _N, _HorC) :-
    !.

%-------------------------------------------------------------------------------

maybe_semi_stan(FORMULA, N, HorC) :-
    standardisation_is_on,
    !,
    is_relational_expression(FORMULA, RELOP, X, Y, TYPE_OF_ARGS),
    !,
    norm_typed_expr(X, TYPE_OF_ARGS, X1),
    !,
    norm_typed_expr(Y, TYPE_OF_ARGS, Y1),
    !,
    NEWFORM =.. [RELOP, X1, Y1],
    !,
    (
       NEWFORM = FORMULA
    ;
       complexity(NEWFORM, N, HorC, ss, _),
       save_semi_stan_fact(NEWFORM, N, HorC)
    ),
    !.

%-------------------------------------------------------------------------------

is_relational_expression(X=Y, =, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

is_relational_expression(X<>Y, <>, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

is_relational_expression(X<=Y, <=, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

is_relational_expression(X>=Y, >=, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

is_relational_expression(X<Y, <, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

is_relational_expression(X>Y, >, X, Y, TYPE) :-
    checktype(X, TYPE), checktype(Y, TYPE), !.

%-------------------------------------------------------------------------------

save_complexity(HorC, N, XXX, COMPLEXITY) :-
    retractall(complexity_fact(HorC, N, XXX, _)),
    !,
    assertz(complexity_fact(HorC, N, XXX, COMPLEXITY)).

%-------------------------------------------------------------------------------

complexity_token([s,_], s) :- !.

complexity_token(X, X).

%-------------------------------------------------------------------------------

save_stan_fact(NEWFORM, N, hyp) :-
    prune_all_hyps(PLACE_HOLDER, [s, TYPE], N),
    !,
    save_stan_fact_x(NEWFORM, TYPE),
    !,
    PLACE_HOLDER = NEWFORM,
    add_hyp_with_id(PLACE_HOLDER, [s, TYPE], N),
    !.

save_stan_fact(NEWFORM, N, conc) :-
    prune_all_concs(PLACE_HOLDER, [s, TYPE], N),
    !,
    save_stan_fact_x(NEWFORM, TYPE),
    !,
    PLACE_HOLDER = NEWFORM,
    add_conc_with_id(PLACE_HOLDER, [s, TYPE], N),
    !.

save_stan_fact(_NEWFORM, _N, HorC):-
    show_error('HorC is not hyp or conc but is ~a in save_stan_fact.', [HorC]).

%-------------------------------------------------------------------------------

save_stan_fact_x(NEWFORM, TYPE):-
    is_relational_expression(NEWFORM, _, _, _, TYPE),
    !.

save_stan_fact_x(_NEWFORM, '@'):-
    !.

%-------------------------------------------------------------------------------

save_semi_stan_fact(NEWFORM, N, hyp) :-
    prune_all_hyps(PLACE_HOLDER, ss, N),
    !,
    PLACE_HOLDER = NEWFORM,
    add_hyp_with_id(PLACE_HOLDER, ss, N),
    !.

save_semi_stan_fact(NEWFORM, N, conc) :-
    prune_all_concs(PLACE_HOLDER, ss, N),
    !,
    PLACE_HOLDER = NEWFORM,
    add_conc_with_id(PLACE_HOLDER, ss, N),
    !.

save_semi_stan_fact(_NEWFORM, _N, HorC) :-
    show_error('HorC is not hyp or conc but is ~a in save_semi_stan_fact.', [HorC]).

%###############################################################################
%                 C O N T R A D I C T I O N    H U N T E R
%###############################################################################

% (1) See if know "false".
% (2) For each known P, see if (not P)', sf(not P), ssf(not P) known.
% (3) See if can infer empty-range, e.g. for all X in A..B, that A>B (in other
%     words, a "contradictory pair", e.g. x>3 and x<0).
% (4) Perform forward-inferences and standardise to form additional sf facts
%     [must keep pointers to hypotheses used].
% (5) Perform equality (and equivalence) substitutions to generate new facts and
%     try standardising these to see if a contradiction can be established.

contradiction_hunt :-
    proved_all_conclusions,
    !.

contradiction_hunt :-
    contradiction_hunt_is_on,
    (
       (
          % (1)
          issue_message('Contradiction hunt phase 1', []),
          see_if_know_false(Hs), K='false-hypothesis'
       ;
          % (2)
          issue_message('Contradiction hunt phase 2', []),
          see_if_know_P_and_not_P(Hs), K='P-and-not-P'
       ;
          % (3)
          issue_message('Contradiction hunt phase 3', []),
          see_if_can_infer_empty_range(Hs), K='empty-range'
       ),
       assert_log_fact(contradiction, [K, Hs])
    ;
       standardisation_is_on,
       % (4)
       issue_message('Contradiction hunt phase 4', []),
       perform_forward_inferences,
       % (5)
       issue_message('Contradiction hunt phase 5', []),
       see_if_contradiction_through_substitutions
    ),

    assertz(found_contradiction),
    issue_found_contradiction_message,
    !.

contradiction_hunt :-
    !.

%-------------------------------------------------------------------------------

% (1) see_if_know_false.
see_if_know_false([N]) :-
    get_hyp(false, _, N),
    !.

%-------------------------------------------------------------------------------

% (2): see_if_know_P_and_not_P.
see_if_know_P_and_not_P(Hs) :-
    get_hyp(P, XXX, N),
    form_negation(P, NotP),
    (
       infer(NotP, M)
    ;
       XXX = x,
       sufficiently_low_complexity(hyp, N),
       standardisation_is_on,
       (
          try_infer_standard_form_of(NotP, M)
       ;
          try_infer_semi_standard_form_of(NotP, M)
       )
    ),
    !,
    merge_sort([N], M, Hs),
    !.

%-------------------------------------------------------------------------------

sufficiently_low_complexity(HorC, N) :-
    complexity_limit(LIM),
    complexity_fact(HorC, N, _, C),
    C < LIM,
    !.

%-------------------------------------------------------------------------------

form_negation( X = Y ,  X <> Y  ) :- !.
form_negation( X <> Y,  X = Y   ) :- !.
form_negation( X < Y,   X >= Y  ) :- !.
form_negation( X > Y,   X <= Y  ) :- !.
form_negation( X <= Y,  X > Y   ) :- !.
form_negation( X >= Y,  X < Y   ) :- !.
form_negation( not P ,  P       ) :- !.
form_negation( P,       not P   ) :- !.

%-------------------------------------------------------------------------------

try_infer_standard_form_of(P, Hs) :-
    norm_typed_expr(P, boolean, NormP),
    !,
    infer(NormP, Hs),
    !.

%-------------------------------------------------------------------------------

try_infer_semi_standard_form_of(P, Hs) :-
    is_relational_expression(P, RELOP, X, Y, TYPE_OF_ARGS),
    !,
    norm_typed_expr(X, TYPE_OF_ARGS, X1),
    !,
    norm_typed_expr(Y, TYPE_OF_ARGS, Y1),
    !,
    SemiStanP =.. [RELOP, X1, Y1],
    !,
    infer(SemiStanP, Hs),
    !.

%-------------------------------------------------------------------------------

% (3): see_if_can_infer_empty_range(Hyps)
% N.B. We consider an expression E:
%
%                ------------>------<------------
%                 E <= A......      ......E >= B  .
%
%   A=B, (E<A, E>=A | E<=A, E>A) are covered by P_and_not_P search.
%   That leaves A=B and E<A, E>A, and
%               A<B (w.l.o.g.) and one of (E<A, E>=B), (E<=A, E>B), (E<=A, E>=B).
%   Cover E<A<E by finding match E<A and trying to infer E>A.
%   Cover three A<B cases by finding matches E<=A and E>=B and inferring A<B.

see_if_can_infer_empty_range(Hs) :-
    (
       infrule(E < A, H1),
       retractall(used(_)),
       infer(E > A, H2),
       merge_sort(H1, H2, Hs)
    ;
       infrule(E <= A, H1),

       % Part of predicate see_if_know_P_and_not_P/1 involves seeking
       % hyps of the form A=B, and trying to infer A<>B. Thus, it is a
       % waste of resources to consider again an inequality which may
       % be directly derived from a hypothesis equality. To guard for
       % this, we only continue if there is not a hyp of the form E=A
       % or A=E.
       \+ (get_hyp(E=A,_,_) ; get_hyp(A=E,_,_)),

       retractall(used(_)),
       infrule(E >= B, H2),
       infer(A < B, H3),
       merge_sort(H1, H2, Hx),
       merge_sort(Hx, H3, Hs)
    ),
    !.

%-------------------------------------------------------------------------------

% (4): perform_forward_inferences.
perform_forward_inferences :-
    initialise_counter(forward_inferences),
    retractall(pairing_depth(_)),
    assertz(pairing_depth(-1)),
    repeat,
       increment_counter(pairing_depth),
       pairing_depth(DEPTH),
       form_new_pairing(DEPTH),
       increment_counter(forward_inferences),
       % until
       sufficient_forward_inferences_or_too_deep,
    !.

%-------------------------------------------------------------------------------

initialise_counter(X) :-
    F =.. [X, Y],
    retractall(F),
    Y = 0,
    asserta(F),
    !.

increment_counter(X) :-
    F =.. [X, Yold],
    G =.. [X, Ynew],
    retract(F),
    Ynew is Yold + 1,
    asserta(G),
    !.

%-------------------------------------------------------------------------------

form_new_pairing(0) :-
    get_hyp(X, [s, Tx], Nx),
    get_hyp(Y, [s, Ty], Ny),
    Nx < Ny,
    join(X, Tx, Nx, Y, Ty, [Ny], 1, normal).

form_new_pairing(D) :-
    D > 0,
    D1 is D + 1,
    get_hyp(X, [s, Tx], Nx),
    join_hyp(D, Y, Ty, Ny),
    join(X, Tx, Nx, Y, Ty, Ny, D1, normal).

% ensure can get out!
form_new_pairing(D) :- D > 5, !.

%-------------------------------------------------------------------------------

% join(X, Tx, Nx, Y, Ty, Ny, D, SAVE).
join( X1 = I1,  T, N1,     X2 = I2,  T, N2,   D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, []),
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X = I, T, N, SAVE).

join( X1 = I1,  T, N1,     X2 > I2,  T, N2,   D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [2]),  % 2nd. positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X > I, T, N, SAVE).

join( X1 = I1,  T, N1,     X2 <> I2, T, N2,   D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, []),
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X <> I, T, N, SAVE).

join( X1 > I1,  T, N1,     X2 > I2,  T, N2,   D, SAVE ) :-
    (
       T = integer,
       IM = 1
    ;
       T = real,
       IM = 0
    ),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1, 2]),  % Both positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2 + IM * (M1 + M2 - 1),
    save_join_hyp(D, X > I, T, N, SAVE).

join( X1 > I1,  T, N1,     X2 = I2,  T, N2,   D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1]),  % 1st. positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X > I, T, N, SAVE).

join( X1 <> I1, T, N1,     X2 = I2,  T, N2,   D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, []),
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X <> I, T, N, SAVE).

% The following should appear for reals only:
join( X1 = I1,  T, N1,     X2 >= I2, real, N2, D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [2]),  % 2nd. positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X >= I, real, N, SAVE).

join( X1 >= I1, real, N1,  X2 = I2,  T, N2,    D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1]),  % 1st. positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X >= I, real, N, SAVE).

join( X1 >= I1, real, N1,  X2 >= I2, real, N2, D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1, 2]),  % Both positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X >= I, real, N, SAVE).

join( X1 > I1,  T, N1,     X2 >= I2, real, N2, D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1, 2]),  % i.e. both positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X > I, real, N, SAVE).

join( X1 >= I1, real, N1,  X2 > I2,  T, N2,    D, SAVE ) :-
    (T = integer ; T = real),
    insert(N1, N2, N),
    find_multipliers(X1, X2, M1, M2, [1, 2]),  % i.e. both positive
    norm_typed_expr(M1 * X1 + M2 * X2, T, X),
    I iss M1 * I1 + M2 * I2,
    save_join_hyp(D, X > I, real, N, SAVE).


find_multipliers(X1, X2, M1, M2, []) :-
    find_common_multipliers(X1, X2, M1, M2).

find_multipliers(X1, X2, M1, M2, [1]) :-
    find_common_multipliers(X1, X2, MX1, MX2),
    (
       MX1 > 0,
       M1=MX1,
       M2=MX2
    ;
       MX1 < 0,
       M1 iss -MX1,
       M2 iss -MX2
    ).

find_multipliers(X1, X2, M1, M2, [2]) :-
    find_common_multipliers(X1, X2, MX1, MX2),
    (
       MX2 > 0,
       M1=MX1,
       M2=MX2
    ;
       MX2 < 0,
       M1 iss -MX1,
       M2 iss -MX2
    ).

find_multipliers(X1, X2, M1, M2, [1, 2]) :-
    find_common_multipliers(X1, X2, MX1, MX2),
    (
       MX1 > 0,
       MX2 > 0,
       M1=MX1,
       M2=MX2
    ;
       MX1 < 0,
       MX2 < 0,
       M1 iss -MX1,
       M2 iss -MX2
    ).

%-------------------------------------------------------------------------------

find_common_multipliers(X1, X2, M1, M2) :-
    know_term_breakdown(X1, TL1),
    know_term_breakdown(X2, TL2),
    !,
    find_cancellation(TL1, TL2, M1, M2).

%-------------------------------------------------------------------------------

find_cancellation(TL1, TL2, M1, M2) :-
    gen_is_in([X, I1], TL1),
    is_in([X, I2], TL2),
    int_and_sign(I1, PI1, SI1),
    int_and_sign(I2, PI2, SI2),
    lcm(PI1, PI2, LCM),
    M1 iss SI1 * (LCM div PI1),
    M2 iss - SI2 * (LCM div PI2).

%-------------------------------------------------------------------------------

gen_is_in(X, [X|_]).

gen_is_in(X, [_|Y]) :- gen_is_in(X, Y).

%-------------------------------------------------------------------------------

int_and_sign(I, I, 1) :- integer(I), I > 0, !.
int_and_sign(0, _, _) :- !, fail.
int_and_sign(-(0), _, _) :- !, fail.

int_and_sign(I, II, - 1) :-
    s_integer(I),
    I < 0,
    !,
    II iss - I.

%-------------------------------------------------------------------------------

lcm(X, Y, LCM) :-
    gcd(X, Y, GCD),
    LCM iss (X * Y) div GCD,
    !.

%-------------------------------------------------------------------------------

gcd(X, X, X) :- !.
gcd(X, 0, X) :- !.

gcd(X, Y, G) :-
    X > Y,
    Y > 0,
    Z is X mod Y,
    !,
    gcd(Y, Z, G).

% this causes gcd(50,50,1) to fail, rather than loop via the next clause.
gcd(X, X, G) :- !, G=X.

gcd(X, Y, G) :-
    Y > 0,
    !,
    gcd(Y, X, G).

%-------------------------------------------------------------------------------

save_join_hyp(_D, X, _T, N, normal) :-
    test_if_contradiction(X, N).

save_join_hyp(_D, X, _T, _N, _) :-
    get_hyp(X, _, _),
    !.

save_join_hyp(_D, X, _T, _N, _) :-
    join_hyp(_, X, _, _),
    !.

save_join_hyp(D, X, T, N, normal) :-
    assertz(join_hyp(D, X, T, N)),
    !.

save_join_hyp(_D, X, _T, _N, reduction) :-
    reduction_hyp(X, _),
    !.

save_join_hyp(_D, X, _T, N, reduction) :-
    simplify(X, XX),
    assertz(reduction_hyp(XX, N)),
    !,
    (
       XX = false
    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

test_if_contradiction(X, Hs) :-
    X =.. [_OP, A, _B],
    int(A),                 % and we know int(B), so.
    simplify(X, false),
    assertz(found_contradiction),
    issue_found_contradiction_message,
    assert_log_fact(contradiction, ['contradictory-combination', Hs]),
    fail.

%-------------------------------------------------------------------------------

sufficient_forward_inferences_or_too_deep :-
    inference_limit(INF),
    forward_inferences(N),

    N > INF,
    !.

sufficient_forward_inferences_or_too_deep :-
    depth_limit(DEPTH),
    pairing_depth(D),
    D >= DEPTH,
    !.

%-------------------------------------------------------------------------------

% (5): see_if_contradiction_through_substitutions(Hyps)
see_if_contradiction_through_substitutions :-
    complexity_limit(L),
    Lim is 3 * L,           % allow some expansion leeway
    infrule(X = Y, N),
    not_too_complex(N, Lim),
    try_replacement(X, Y, N),
    % until
    found_contradiction.

see_if_contradiction_through_substitutions :-
    get_hyp(X, x, N),
    var_const(X, boolean, _),
    try_replacement(X, true, N),
    % until
    found_contradiction.

see_if_contradiction_through_substitutions :-
    get_hyp(not X, x, N),
    var_const(X, boolean, _),
    try_replacement(X, false, N),
    % until
    found_contradiction.

see_if_contradiction_through_substitutions :-
    found_contradiction,
    !.

%-------------------------------------------------------------------------------

not_too_complex([H|T], Lim) :-
    Lim > 0,
    complexity_fact(hyp, H, _, C),
    % So C is largest complexity for H
    \+ ( complexity_fact(hyp, H, _, N), N>C ),
    NewLim is Lim - C,
    !,
    not_too_complex(T, NewLim).

not_too_complex([], Lim) :-
    !,
    Lim >= 0.

%-------------------------------------------------------------------------------

try_replacement(I, _Y, _N) :-
    s_integer(I),
    !,
    fail.

try_replacement(X, Y, N) :-
    get_subst_hyp(H, L, Hs),
    has_complexity(H, C),
    complexity_limit(Lim),
    % allow some expansion leeway
    C =< 3 * Lim,
    \+ is_in([X,Y], L),
    \+ is_in([Y,X], L),
    subst_vbl(X, Y, H, S),
    H \= S,
    merge_sort([N], Hs, NewHs),
    maybe_stan_and_store_hyp(S, [[X,Y]|L], NewHs).

try_replacement(X, Y, N) :-
    get_hyp(H, x, K),
    complexity_fact(hyp, K, _, C),
    \+ ( complexity_fact(hyp, K, _, W), W>C ),      % So C is largest complexity for Hk
    complexity_limit(L),
    C =< 3 * L,                                     % allow some expansion leeway
    subst_vbl(X, Y, H, S),
    H \= S,
    K \= N,
    maybe_stan_and_store_hyp(S, [[X,Y]], [K,N]).

%-------------------------------------------------------------------------------

maybe_stan_and_store_hyp(S, L, Hs) :-
    complexity_limit(LIM),
    has_complexity(S, C),
    C < LIM,
    norm_typed_expr(S, boolean, S1),
    add_subst_hyp(S1, L, Hs),
    (
       S1 = false,
       assertz(found_contradiction),
       issue_found_contradiction_message,
       assert_log_fact(contradiction,
                        ['contradiction-through-substitutions', Hs])
    ;
       true
    ),
    !.

maybe_stan_and_store_hyp(S, L, Hs) :-
    add_subst_hyp(S, L, Hs),
    !.

%###############################################################################
%                 E X P R E S S I O N    R E D U C T I O N
%###############################################################################

expression_reduction :- found_contradiction, !.
expression_reduction :- proved_all_conclusions, !.

expression_reduction :-
    expression_reduction_is_on,
    expression_reduction1.

expression_reduction :-
    \+ expression_reduction_is_on,
    !.

%-------------------------------------------------------------------------------

expression_reduction1 :- eliminate_true_hypotheses.
expression_reduction1 :- try_reducing_disjunction_options.
expression_reduction1 :- eliminate_duplicates.

expression_reduction1 :- eliminate_complementary_pair_disjunctions.
expression_reduction1 :- try_simplifying_implications_and_equivalences.
expression_reduction1 :- try_join_negations_to_get_contradiction.
expression_reduction1 :- try_obvious_substitutions.
expression_reduction1 :- eliminate_true_hypotheses.
expression_reduction1 :- reduce_conclusions.

expression_reduction1 :-
    see_if_know_false(Hs),          % last attempt.
    assert_log_fact(contradiction, ['false-hypothesis', Hs]),
    assertz(found_contradiction),
    issue_found_contradiction_message.

expression_reduction1 :- !.

%-------------------------------------------------------------------------------

eliminate_true_hypotheses :-
    get_hyp(true, _, N),
    save_eliminate(N, 'true-hypothesis', []),
    fail.

%-------------------------------------------------------------------------------

reduce_conclusions :-
    get_conc(A or B, _X, N),
    \+ get_proved_conc(N),
    try_reduce_disjunction_conclusion(N, A or B, _C),
    fail.

reduce_conclusions :-
    get_conc(X, _, M),
    get_conc(X, _, N),
    M < N,
    \+ get_proved_conc(N),
    assert_log_fact(eliminated_conc, [N, M]),
    add_proved_conc(N),
    fail.

%-------------------------------------------------------------------------------

try_reduce_disjunction_conclusion(N, A or B, C) :-
    reduce_disjunction(A or B, C, Hs),
    C \= (A or B),
    !,
    replace_conc(A or B, X, N, C),
    !,
    (
       C=true,
       assert_log_fact(proved, [N, A or B, Hs, A or B]),
       add_proved_conc(N),
       issue_proved_message(N)
    ;
       X = x,
       assert_log_fact(further_simplified, [conc, N, A or B, C, Hs]),
       (
          infer(C, H2),
          merge_sort(Hs, H2, Hyps),
          !,
          assert_log_fact(proved, [N, C, Hyps, C]),
          add_proved_conc(N),
          issue_proved_message(N)
       ;
          true
       )
    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

% "try_reducing_disjunction_options" always fails eventually
try_reducing_disjunction_options :-
    repeat,
        % until
        reduced_all_disjunctions,
    !,
    fail.

%-------------------------------------------------------------------------------

reduced_all_disjunctions :-
    get_hyp(A or B, x, N),
    try_reducing_disjunction(A or B, x, N),
    !,
    fail.

% succeed when none left to reduce
reduced_all_disjunctions.

%-------------------------------------------------------------------------------

try_reducing_disjunction(A or B, X, N) :-
    reduce_disjunction(A or B, C, Hs),
    C \= (A or B),
    !,
    replace_hyp(_Old_Hyp, X, N, C),
    !,
    (
       X = x,
       (
          C=true,
          save_eliminate(N, 'true-disjunction', [])
       ;
          assert_log_fact(further_simplified, [hyp, N, A or B, C, Hs])
       )
    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

reduce_disjunction(A or _B, true, Hs) :-
    infer(A, Hs),
    !.

reduce_disjunction(_A or B, true, Hs) :-
    infer(B, Hs),
    !.

reduce_disjunction(A or B, AA, Hs) :-
    infer(not B, H1),
    !,
    reduce_disjunction(A, AA, H2),
    !,
    merge_sort(H1, H2, Hs),
    !.

reduce_disjunction(A or B, BB, Hs) :-
    infer(not A, H1),
    !,
    reduce_disjunction(B, BB, H2),
    !,
    merge_sort(H1, H2, Hs),
    !.

reduce_disjunction(A or B, C, Hs) :-
    reduce_disjunction(A, AA, H1),
    reduce_disjunction(B, BB, H2),
    !,
    (
       (
          AA = true
       ;
          BB = true
       ),
       C = true
    ;
       C = (AA or BB)
    ),
    !,
    merge_sort(H1, H2, Hs),
    !.

reduce_disjunction(A, A, []) :- !.

%-------------------------------------------------------------------------------

eliminate_duplicates :-
    get_hyp(X, _, M),
    get_hyp(X, _, N),
    M < N,
    name(M, ML),
    append("duplicate of H", ML, MessL),
    name(Message, MessL),
    save_eliminate(N, Message, []),
    fail.

%-------------------------------------------------------------------------------

eliminate_complementary_pair_disjunctions :-
    get_hyp(X or Y, _, N),
    redundant_disjunction(X or Y),
    save_eliminate(N, 'P-or-not-P disjunction', []),
    fail.

%-------------------------------------------------------------------------------

% REDUNDANT_DISJUNCTION(F) - checks if F covers all integers for some subexpression
%                            or if F is basically "X or not X" for some formula X.

redundant_disjunction(A or (not A)) :- !.
redundant_disjunction((not A) or A) :- !.

redundant_disjunction(A or B) :-
   standardisation_is_on,
   norm_typed_expr((not A)<->B,boolean,true),
   !.

redundant_disjunction(F) :-
   covers_interval(F,E,L,U),
   (
      L=[]
   ;
      infer(E>=L)
   ),
   (
      U=[]
   ;
      infer(E<=U)
   ), !.

%-------------------------------------------------------------------------------

% COVERS_INTERVAL(F,E,L,U) - expression E ranges over L..U in F.
covers_interval(F1 and F2,E,L,U) :- find_range(F1 and F2,E,L,U).

covers_interval(E=N,E,N,N).

covers_interval(N=E,E,N,N).

covers_interval(E<N,E,[],N-1).

covers_interval(N>E,E,[],N-1).

covers_interval(E<=N,E,[],N).

covers_interval(N>=E,E,[],N).

covers_interval(E>N,E,N+1,[]).

covers_interval(N<E,E,N+1,[]).

covers_interval(E>=N,E,N,[]).

covers_interval(N<=E,E,N,[]).

covers_interval(A or B,E,L,U) :-
   covers_interval(A,E,L1,U1),
   covers_interval(B,E,L2,U2),
   combine_intervals(L1,U1,L2,U2,L,U),
   !.

%-------------------------------------------------------------------------------

% FIND_RANGE(CONJ,E,L,U) - find E in CONJ covering L..U in CONJ.
find_range(F1 and F2,E,L,U) :-
   covers_interval(F1,E,L1,U1),
   covers_interval(F2,E,L2,U2),
   find_max(L1,L2,L),
   find_min(U1,U2,U),
   infer(L<=U).

%-------------------------------------------------------------------------------

% FIND_MAX(N1,N2,N) - find N in {N1,N2} s.t. N>=N1 and N>=N2.
find_max(N1,N2,N) :-
   (
    intexp(N1),
    (
       intexp(N2),
       (
      N1>=N2,
      N is N1
       ;
      N2>N1,
      N is N2
       )
    ;
       V is N1,
       (
      infer(V>=N2),
      N=V
       ;
      infer(N2>=V),
      N=N2
       )
    )
   ;
    intexp(N2),
    V is N2,
    (
       infer(N1>=V),
       N=N1
    ;
       infer(V>=N1),
       N=V
    )
   ;
    infer(N1>=N2),
    N=N1
   ;
    infer(N2>=N1),
    N=N2
   ), !.

%-------------------------------------------------------------------------------

% FIND_MIN(N1,N2,N) - find N in {N1,N2} s.t. N<=N1 and N<=N2.
find_min(N1,N2,N) :-
   (
    intexp(N1),
    (
       intexp(N2),
       (
      N1>=N2,
      N is N2
       ;
      N2>N1,
      N is N1
       )
    ;
       V is N1,
       (
      infer(V>=N2),
      N=N2
       ;
      infer(N2>=V),
      N=V
       )
    )
   ;
    intexp(N2),
    V is N2,
    (
       infer(N1>=V),
       N=V
    ;
       infer(V>=N1),
       N=N1
    )
   ;
    infer(N1>=N2),
    N=N2
   ;
    infer(N2>=N1),
    N=N1
   ), !.

%-------------------------------------------------------------------------------

% COMBINE_INTERVALS(L1,L2,U1,U2,LRes,URes) - combine L1..L2 & L2..U2.
combine_intervals(L1,U1,U1,U2,L1,U2) :- U1\=[].

combine_intervals(U1,U2,L1,U1,L1,U2) :- U1\=[].

combine_intervals(L1,L2-1,L2,U2,L1,U2).

combine_intervals(L2,U2,L1,L2-1,L1,U2).

combine_intervals(L1,L2,L2+1,U2,L1,U2).

combine_intervals(L2+1,U2,L1,L2,L1,U2).

combine_intervals(L1,U1,L2,U2,L2,U1) :-
   U2\=[],
   L1\=[],
   (
      standardisation_is_on,
      norm_typed_expr(U2+1>=L1,boolean,true)
   ;
      infer(U2+1>=L1)
   ;
      infer(U2>=L1-1)
   ;
      infer(L1<=U2)
   ).

combine_intervals(L1,U1,L2,U2,L1,U2) :-
   U1\=[],
   L2\=[],
   (
      standardisation_is_on,
      norm_typed_expr(U1+1>=L2,boolean,true)
   ;
      infer(U1+1>=L2)
   ;
      infer(U1>=L2-1)
   ;
      infer(L2<=U1)
   ).

combine_intervals(L1,_U1,L2,U2,L2,U2) :-
   L1\=[],
   L2\=[],
   (
      standardisation_is_on,
      norm_typed_expr(L2<=L1,boolean,true)
   ;
      infer(L2<=L1)
   ).

%-------------------------------------------------------------------------------

try_simplifying_implications_and_equivalences :-
    get_hyp(A -> B, x, N),
    \+ log_fact(forwardchain2, [N, _, B]),
    infer(A, Hs),
    update_implication(N),
    assert_log_fact(forwardchain2, [N, Hs, B]),
    fail.

try_simplifying_implications_and_equivalences :-
    get_hyp(A <-> B, x, N),
    \+ log_fact(forwardchain2, [N, _, B]),
    infer(A, Hs),
    \+ is_in(N, Hs),
    update_equivalence(x, N, A),
    assert_log_fact(forwardchain2, [N, Hs, B]),
    fail.

try_simplifying_implications_and_equivalences :-
    get_hyp(A <-> B, x, N),
    \+ log_fact(forwardchain2, [N, _, A]),
    infer(B, Hs),
    \+ is_in(N, Hs),
    update_equivalence(x, N, B),
    assert_log_fact(forwardchain2, [N, Hs, A]),
    fail.

%-------------------------------------------------------------------------------

update_implication(N) :-
    update_implication(x, N),
    fail.

update_implication(N) :-
    update_implication(ss, N),
    fail.

update_implication(N) :-
    update_implication([s,_], N),
    fail.

update_implication(_N) :- !.

%-------------------------------------------------------------------------------

update_implication(X, N) :-
    replace_hyp(_A -> B, X, N, B),
    complexity_token(X, XX),
    retract(complexity_fact(hyp, N, XX, _)),
    complexity(B, N, hyp, XX, _),
    !.

%-------------------------------------------------------------------------------

update_equivalence(X, N, A) :-
    replace_hyp(A <-> B, X, N,  B),
    complexity_token(X, XX),
    retract(complexity_fact(hyp, N, XX, _)),
    complexity(B, N, hyp, XX, _),
    !.

update_equivalence(X, N, A) :-
    replace_hyp(B <-> A, X, N, B),
    complexity_token(X, XX),
    retract(complexity_fact(hyp, N, XX, _)),
    complexity(B, N, hyp, XX, _),
    !.

%-------------------------------------------------------------------------------

try_join_negations_to_get_contradiction :-
    standardisation_is_on,
    get_hyp(X, [s, Tx], Nx),
    retractall(reduction_hyp(_,_)),
    form_negation(X, NotX),
    norm_typed_expr(NotX, boolean, NormNotX),
    try_eliminating(NormNotX, Tx, Nx),
    fail.

%-------------------------------------------------------------------------------

try_eliminating(X, Tx, Nx) :-
    get_hyp(Y, [s, Ty], Ny),
    Nx \= Ny,
    \+ know_eliminated(Ny),
    join(X, Tx, Nx, Y, Ty, [Ny], 1, reduction),
    fail.

try_eliminating(X, Tx, Nx) :-
    join_hyp(_, Y, Ty, Ny),
    \+ is_in(Nx, Ny),
    \+ exists_eliminated_in_list(Ny),
    join(X, Tx, Nx, Y, Ty, Ny, 1, reduction),
    fail.

try_eliminating(_X, _Tx, Nx) :-
    reduction_hyp(false, Hs),
    save_eliminate(Nx,'redundant',Hs),
    !.

%-------------------------------------------------------------------------------

exists_eliminated_in_list([Ny|_]) :-
    know_eliminated(Ny),
    !.

exists_eliminated_in_list([_|Rest]) :-
    exists_eliminated_in_list(Rest),
    !.

%-------------------------------------------------------------------------------

save_eliminate(N, _, _) :-
    know_eliminated(N),
    !.

save_eliminate(N, Message, Hs) :-
    assertz(know_eliminated(N)),
    issue_elimination_message(N),
    eliminate_N_from_HL(N, Hs, Hlist),
    assert_log_fact(eliminated_hyp, [N, Message, Hlist]),
    !.

%-------------------------------------------------------------------------------

eliminate_N_from_HL(N, [N|Rest], HRest) :-
    !,
    eliminate_N_from_HL(N, Rest, HRest).

eliminate_N_from_HL(N, [H|Rest], [H|HRest]) :-
    !,
    eliminate_N_from_HL(N, Rest, HRest).

eliminate_N_from_HL(_N, [], []) :- !.

%-------------------------------------------------------------------------------

try_obvious_substitutions :-
    % always fails
    do_obvious_substitutions_at_depth(toplevel).

%###############################################################################
%                 P R O O F    O F    C O N C L U S I O N S
%###############################################################################

try_to_prove_concs :-
    % Stop if all conclusions have been proved.
    proved_all_conclusions,
    !.

try_to_prove_concs :-
    % Stop if contradictions have been found.
    found_contradiction,
    !.

try_to_prove_concs :-
    get_conc(REAL_C, x, N),
    (
       C = REAL_C
    ;
       get_conc(C, [s|_], N),
       C \= REAL_C
    ;
       get_conc(C, ss, N),
       C \= REAL_C
    ),
    \+ get_proved_conc(N),
    try_to_prove_conc(C, N, REAL_C).

try_to_prove_concs :- !.


%-------------------------------------------------------------------------------

try_to_prove_conc(C, N, X) :-
    clear_up_could_and_could_not_infer_facts,
    infer(C, Hs),
    add_proved_conc(N),
    issue_proved_message(N),
    assert_log_fact(proved, [N, C, Hs, X]),
    !,
    fail.

try_to_prove_conc(C, N, X) :-
    join_hyp(_, C, _, Hs),
    add_proved_conc(N),
    issue_proved_message(N),
    assert_log_fact(proved, [N, C, Hs, X]),
    !,
    fail.

%-------------------------------------------------------------------------------


clear_up_could_and_could_not_infer_facts :-
    retractall(could_infer(_, _)),
    retractall(could_not_infer(_)),
    retractall(known_upper_numeric_limit(_,_,_,_)),
    retractall(known_lower_numeric_limit(_,_,_,_)),
    !.

%-------------------------------------------------------------------------------

issue_found_contradiction_message :-
    issued_contradiction_message,
    !.

issue_found_contradiction_message :-
    path_functions,
    issue_message('Found contradiction in path traversal condition',[]),
    issue_message('Path eliminated',[]),
    assert_log_fact(proved_all, []),
    assertz(issued_contradiction_message),
    !.

issue_found_contradiction_message :-
    issue_message('Found contradiction within hypotheses',[]),
    issue_message('VC is therefore true',[]),
    assert_log_fact(proved_all, []),
    assertz(issued_contradiction_message),
    !.

%-------------------------------------------------------------------------------

issue_elimination_message(_N) :-
    path_functions,
    !,
    issue_message('Eliminated a traversal condition', []),
    !.

issue_elimination_message(_N) :-
    issue_message('Eliminated a redundant hypothesis', []),
    !.

%-------------------------------------------------------------------------------

issue_substitution_message(N) :-
    % Eliminated an X=Y hypothesis
    integer(N),
    !,
    issue_message('Eliminated equality hypothesis H', N),
    !.

issue_substitution_message(N) :-
    issue_message('Applied substitution rule ', N),
    !.

%-------------------------------------------------------------------------------

issue_proved_message(N) :-
    issue_message('PROVED C',N),
    !.

%-------------------------------------------------------------------------------

maybe_issue_proved_vc_message :-
    issued_vc_proved_message,
    !.

maybe_issue_proved_vc_message :-
    issue_message('Proved all conclusions - VC eliminated', []),
    assertz(issued_vc_proved_message),
    assert_log_fact(proved_all, []),
    !.


%-------------------------------------------------------------------------------

issue_message(_X, _Y) :-
    % if verbose mode off, do nothing.
    get_switch_verbose(off),
    !.


issue_message(X, Y) :-
    % if verbose mode on, dump output to screen.
    get_switch_verbose(on),
    telling(F),
    tell(user),
    write('*** '),
    (
        % if plain mode is off, then timestamp each message
        get_switch_plain(off),
        fetch_date_and_time(_DATE, TIME),
        write(TIME),
        write(' ')
    ;
        % if plain mode is on, then no timestamp
        get_switch_plain(on)
    ),
    write(X),
    (
      Y = []
    ;
      write(Y)
    ),
    !,
    nl,
    tell(F),
    !.

%----------------------------------------------------------------------------

do_rule_substitutions1 :-
    \+ rule_substitution_is_on,
    !.

do_rule_substitutions1 :-
    rule_substitution_is_on,
    find_max_conc_no,
    max_conc_no(MAX),
    retractall(hn(_)),
    asserta(hn(1)),
    repeat,
       fetch_next_hn(N),
       replace_conc_rule(N),
       % until
       N = MAX,
    !.

%----------------------------------------------------------------------------




replace_conc_rule(N) :-
    get_proved_conc(N),
    !.

replace_conc_rule(N) :-
    get_conc(C, x, N),
    (
       replace_conc_rule1(C)
    ;
       % Where Conclusion N has constants that can be replaced on BOTH the
       % Left and Right hand sides, then we have to try again.
       % The first replace_conc_rule1(C) above might have changed conc/3
       % so we have to match again to pick it up as C2 here.
       get_conc(C2, x, N),
       replace_conc_rule1(C2)
    ).

% No more conclusions left, then just succeed.
replace_conc_rule(_N) :-
    !.

%----------------------------------------------------------------------------

replace_conc_rule1(C) :-
    C = (X <= _Y),         % Find a conclusion of the form X <= Y
    var_const(X, _T, c),   % and X denotes an FDL constant
    replace_rule(R, X, V), % and there's a replacement rule for it.
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, toplevel, R, X, V),     % go ahead and replace it.
    fail.

replace_conc_rule1(C) :-
    C = (_X <= Y),         % Find a conclusion of the form X <= Y
    var_const(Y, _T, c),   % and Y denotes an FDL constant
    replace_rule(R, Y, V), % and there's a replacement rule for it.
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, toplevel, R, Y, V),     % go ahead and replace it.
    fail.

replace_conc_rule1(C) :-
    C = (X >= _Y),         % or X >= Y
    var_const(X, _T, c),   % and X denotes an FDL constant
    replace_rule(R, X, V), % and there's a replacement rule for it.
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, toplevel, R, X, V),     % go ahead and replace it.
    fail.

replace_conc_rule1(C) :-
    C = (_X >= Y),         % or X >= Y
    var_const(Y, _T, c),   % and Y denotes an FDL constant
    replace_rule(R, Y, V), % and there's a replacement rule for it.
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, toplevel, R, Y, V), % go ahead and replace it.
    fail.

%----------------------------------------------------------------------------

do_rule_substitutions2 :-
    \+ rule_substitution_is_on,
    !.

do_rule_substitutions2 :-
    rule_substitution_is_on,
    replace_rule(Name, Old, New),
    substitute_and_eliminate(subst_and_elim, user_rule_no, toplevel, Name, Old, New),
    fail.

% At this point, we can also exploit ground condition-less
% user-defined replacement rules where the left-hand side
% denotes an FDL constant
do_rule_substitutions2 :-
    rule_substitution_is_on,
    user_rewrite_rule(File:Name, Old, New, []),
    ground(Old),
    ground(New),
    var_const(Old, _T, c),
    substitute_and_eliminate(subst_and_elim, user_rule_yes(File:Name), toplevel, Name, Old, New),
    fail.

do_rule_substitutions2 :- !.

%---------------------------------------------------------------------------

extended_simplify :-
    get_hyp(Expr, x, N),
    \+ know_eliminated(N),
    try_further_hyp_simplification(Expr, N),
    fail.

extended_simplify :-
    get_conc(Expr, x, N),
    \+ get_proved_conc(N),
    try_further_conc_simplification(Expr, N),
    fail.

extended_simplify. % succeed when none left to reduce

%---------------------------------------------------------------------------

try_further_hyp_simplification(Expr, N) :-
    eliminate_redundant_moduluses(Expr, New, Hs),
    simplify(New, NewExpr),
    !,
    replace_hyp(_Old_Hyp, x, N, NewExpr),
    !,
    (
       NewExpr=true,
       save_eliminate(N, 'redundant', [])
    ;
       assert_log_fact(further_simplified, [hyp, N, Expr, NewExpr, Hs])
    ),
    !.

%---------------------------------------------------------------------------

try_further_conc_simplification(Expr, N) :-
    eliminate_redundant_moduluses(Expr, New, Hs),
    simplify(New, NewExpr),
    !,
    replace_conc(_, x, N, NewExpr),
    assert_log_fact(further_simplified, [conc, N, Expr, NewExpr, Hs]),
    !,
    (
       NewExpr=true,
       assert_log_fact(proved, [N, NewExpr, [], NewExpr]),
       add_proved_conc(N),
       issue_proved_message(N)
    ;
       true
    ),
    !.

%---------------------------------------------------------------------------

eliminate_redundant_moduluses(Expr, NewExpr, Hs) :-
    do_eliminate_redundant_moduluses(Expr, NewExpr, Hs),
    !,
    Expr \= NewExpr.        % only succeed if result is different

%---------------------------------------------------------------------------

do_eliminate_redundant_moduluses(Expr mod N, Result, Hs) :-
    int(N),
    N > 0,
    !,
    do_eliminate_redundant_moduluses(Expr, NewExpr, H1),
    !,
    (
       (
          find_lower_numeric_limit_for(NewExpr, XL, integer, H2),
          simplify(XL >= 0, true)
       ;
          safe_deduce(NewExpr >= 0, integer, H2)
       ),
       find_upper_numeric_limit_for(NewExpr, XU, integer, H3),

       simplify(XU >= 0, true),
       simplify(XU <= N-1, true),
       Result = NewExpr,
       append(H1, H2, Hrest),
       append(H3, Hrest, HL),
       sort(HL, Hs)
    ;
       NewExpr \= Expr,
       Result = NewExpr mod N,
       Hs = H1
    ;
       Result = Expr mod N,
       Hs = []
    ),
    !.

do_eliminate_redundant_moduluses(Atomic, Atomic, []) :-
    atomic(Atomic),
    !.

do_eliminate_redundant_moduluses([H|T], Result, Hs) :-
    !,
    do_eliminate_redundant_moduluses_in_list([H|T], Result, Hs).

do_eliminate_redundant_moduluses(Expr, NewExpr, Hs) :-
    Expr =.. [Op|Args],
    do_eliminate_redundant_moduluses_in_list(Args, NewArgs, Hs),
    !,
    NewExpr =.. [Op|NewArgs].

%---------------------------------------------------------------------------

do_eliminate_redundant_moduluses_in_list([], [], []).
do_eliminate_redundant_moduluses_in_list([H|T], [NewH|NewT], Hs) :-
    do_eliminate_redundant_moduluses(H, NewH, Hh),
    !,
    do_eliminate_redundant_moduluses_in_list(T, NewT, Ht),
    !,
    append(Hh, Ht, HL),
    sort(HL, Hs).

%###############################################################################
%                    P R O O F       S T R A T E G I E S
%###############################################################################

%===============================================================================
% try_proof_framing.
%-------------------------------------------------------------------------------
% The predicate try_proof_framing is called by do_simplify_vc if there are
% still conclusions left to prove after all other armoury has been tried,
% so it is the last resort.
%
% The key characteristic of proof framing, over other strategies in the
% Simplifier, is the creation and investigation of subgoals. These subgoals
% typically contain additional hypotheses which logically can not, or
% simply are not desired, at the top goal level.
%
% The predicate works by calling try_toplevel_proof_strategy/2 for each
% conclusion in turn, with a "depth" which determines how many "proof
% frames" may be entered in the search for a proof (to bound the attempt).
% The maximum value for this depth, which is what it starts as (and counts
% down as successive proof frames are entered) is defined by the predicate
% max_proof_framing_depth(15).
%===============================================================================




try_proof_framing :-
    % do it for the main VC to a limited depth.
    max_proof_framing_depth(MaxDepth),
    % Find how many conclusions post-restructuring.
    find_max_conc_no,
    max_conc_no(MaxConcNumber),
    retractall(pfn(_)),
    asserta(pfn(1)),
    % Repeat for each conclusion.
    repeat,
    clear_up_stack_facts,
    fetch_next_pfn(ConcNumber),
    try_toplevel_proof_strategy(MaxDepth, ConcNumber),
    % until
    ConcNumber = MaxConcNumber,
    !.

%---------------------------------------------------------------------------

% Stop searching at MaxDepth, in trying to prove conclusion ConcNumber.
try_toplevel_proof_strategy(MaxDepth, ConcNumber) :-
    do_try_toplevel_proof_strategy(MaxDepth, ConcNumber),
    !.

% catchall: always succeed
try_toplevel_proof_strategy(_, _) :-
    !.

%---------------------------------------------------------------------------

% Search depth value is hard-coded. Experimentation and experience suggests
% this is a good value.
max_proof_framing_depth(15).

%---------------------------------------------------------------------------

% Fetch next conclusion number to be investigated.
fetch_next_pfn(ConcNumber) :-
    pfn(ConcNumber),
    !,
    retractall(pfn(_)),
    NextConcNumber is ConcNumber + 1,
    asserta(pfn(NextConcNumber)),
    !.

%===============================================================================
% do_try_toplevel_proof_strategy(+Depth, +ConcNumber).
%-------------------------------------------------------------------------------
% This predicate invokes proof framing (also known as subgoaling) depending
% on the form of top level conclusions. This top level phase quickly
% targets those conclusions that are more likely to be susceptible to
% proof framing, and, where successful, records a matching log entry.
%===============================================================================

% No further work needed as conclusion is proved.
do_try_toplevel_proof_strategy(_Depth, ConcNumber) :-
    get_proved_conc(ConcNumber),
    !.

% In describing changed composites, the examiner generates a goal of the
% form:
% H1: constraint(oldvar)
% H2: newvar = update_construct(oldvar except for changed part)
% H3: constraint(changed part of newvar)
% C1: property(in terms of of newvar)
%
% Proof of this goal involves considering the unchanged and the changed
% case. The existing proof by cases strategies perform this directly, if
% newvar is replaced with its updated construct, enabling the proof by
% cases to trigger through syntax matching. Thus, this entry predicate
% applies such rewrites.
do_try_toplevel_proof_strategy(Depth, ConcNumber) :-
    get_conc(Conc, x, ConcNumber),
    % Modify conclusion, by introducing external updates. Only successful if
    % a change is made. Collect relevant hyp numbers for log.
    rewrite_oldvars_with_newvars(Conc, NewConc, HypNumberList),
    !,
    post_rewrite_do_proof_or_fail(Depth, ConcNumber, Conc, NewConc, HypNumberList),

    % Success.
    assert_log_fact(proved_by_framing, [ConcNumber, Conc,
                                        'replacing variables with update structures']),
    issue_proved_message(ConcNumber),
    !.

% Quantifier unwrapping, targeting conclusions of form: for_all(Var:Type, Prop) .
do_try_toplevel_proof_strategy(Depth, ConcNumber) :-
    get_conc(for_all(Var:Type, Prop), x, ConcNumber),
    !,
    do_quantification_proof_or_fail(Depth, ConcNumber, Var, Type, Prop),

    % Success.
    assert_log_fact(proved_by_framing, [ConcNumber, for_all(Var:Type, Prop),
                                        'unwrapping a universally-quantified formula']),
    issue_proved_message(ConcNumber),
    !.

% Proof by implication, targeting conclusions of form: Antecedent -> Consequent.
% Note that the strategy is not recursively attempted on subgoals via
% try_to_discharge_goals_to_depth/1, because this situation is already
% considered by prove_subgoal/3.
do_try_toplevel_proof_strategy(Depth, ConcNumber) :-
    % Implication conclusion.
    get_conc(Antecedent -> Consequent, x, ConcNumber),
    !,
    do_implication_proof_or_fail(Depth, ConcNumber, Antecedent, Consequent),

    % Success.
    assert_log_fact(proved_by_framing, [ConcNumber, Antecedent -> Consequent, implication]),
    issue_proved_message(ConcNumber),
    !.

% Performs a targeted proof by cases, seeking universally quantified
% subexpressions of the form:
% element(update(A, [I], X), [J]) or update(update(A, [I], X), [J], Y)
% Where the Simplifier cannot establish the truth of I=J.
%
% If triggered, a proof by cases is attempted, trying the two cases I=J and
% I<>J in turn. If the conclusion can be proved for each case, then it is
% true and we have completed an automated proof by cases much like a human
% prover would carry out with the Proof Checker for such a conclusion.
do_try_toplevel_proof_strategy(Depth, ConcNumber) :-
    get_conc(Conc, x, ConcNumber),
    is_inequality_with_updates(Conc, CasesList),
    !,
    do_cases_proof_or_fail(Depth, by_cases, ConcNumber, Conc, CasesList),

    % Success.
    assert_log_fact(proved_by_framing, [ConcNumber, Conc,
                                        'cases on index values, given the update(A, [I], X) subexpressions']),
    issue_proved_message(ConcNumber),
    !.

% Performs a targeted proof by cases, seeking goals of the the form:
% Hn: A1 or A2 ... Ai
% ->
% Cm: B1 or B2 ... Bj
%
% If reaching this stage, the simplifier has been unable to prove Cm given
% Hn. The assumption is that Hn is not strong enough to prove Cm. However,
% each disjunct of Hn may be strong enough to prove one disjunct of Cm,
% enabling the proof to be completed. This is attempted through a proof by
% cases on the disjuncts on Hn. Note that, to minimise the search space,
% the strategy is not recursively attempted on subgoals.  Thus, if multiple
% disjoined hypotheses need to be considered (a proof by cases, within a
% proof by cases) the proof will not be found. If this becomes an issue,
% the strategy might be made recursive and its performance impact
% investigated accordingly.
do_try_toplevel_proof_strategy(Depth, ConcNumber) :-
    get_conc(ConcExp, x, ConcNumber),
    is_targeted_disjunction(ConcExp, _CasesList),
    !,
    get_hyp(HypExp, _, HypNumber),
    is_targeted_disjunction(HypExp, CasesList),

    !,
    do_cases_proof_or_fail(Depth, by_cases_hyp, ConcNumber, ConcExp, CasesList),

    % Success.
    assert_log_fact(proved_by_framing_hyp, [ConcNumber, HypNumber, ConcExp,
                                            'cases on disjunction']),
    issue_proved_message(ConcNumber),
    !.

%================================================================================
% rewrite_oldvars_with_newvars(+Conc, -NewConc, -HypNumberList).
%-------------------------------------------------------------------------------
% Succeeds where conclusion is modifed via composite updates.
%================================================================================

rewrite_oldvars_with_newvars(Conc, NewConc, HypNumberList):-
    % Retrieve all composite updates.
    findall(HypNumber-(From, To),
            is_update_hyp(From, To, HypNumber),
            UnsortedUpdateKeyList),

    % Each composite update hypothesis refers to a variable constrained in
    % earlier hypotheses. To apply these updates, unravelling the nesting
    %accordingly, they are reversed.
    keysort(UnsortedUpdateKeyList, SortedUpdateKeyList),
    reverse(SortedUpdateKeyList, RevSortedUpdateKeyList),

    % Apply relevant updates.
    apply_relevant_updates(Conc, RevSortedUpdateKeyList, NewConc, HypNumberList),
    !,

    % Updates were found if some hypotheses rewrites were performed.
    \+ HypNumberList=[],
    !.

%-------------------------------------------------------------------------------
% is_update_hyp(+From, +To, -HypNumber).

is_update_hyp(From, To, HypNumber):-
    % Consider all standard hyps.
    get_hyp(From = To, x, HypNumber),
    % Only select those that transform variables.
    var_const(From, _, v),
    % Only select those that appear to be describing a portion of a
    % composite update.
    is_update_composite_hyp(From, To).

%-------------------------------------------------------------------------------
% is_update_composite_hyp(+From, +To).

% Seek array update at top level of right hand side.
is_update_composite_hyp(From, update(_Array, [_Index], NewValue)):-
    % Check that the updated form is expressed in terms of the old
    % variable.
    exp_contains_exp(NewValue, From),
    !.

% Seek field update at top level of right hand side.
is_update_composite_hyp(From, To):-
    % Check is field update.
    functor(To, Functor, 2),
    atom_concat('upf_', _FieldName, Functor),
    % Retrieve the new value.
    arg(2, To, NewValue),
    % Check that the updated form is expressed in terms of the old
    % variable.
    exp_contains_exp(NewValue, From),
    !.

%-------------------------------------------------------------------------------
% apply_relevant_updates(+Conc, +RevSortedUpdateKeyList, +NewConc, -HypNumberList).

apply_relevant_updates(Conc_m_NewConc, [], Conc_m_NewConc, []):-
    !.

% Apply composite updates whose variable is referenced in the conclusion.
apply_relevant_updates(Conc,
                       [HypNumber-(From, To) | T_UpdateKeyList],
                       NewConc,
                       [HypNumber | T_HypNumberList]):-
    exp_contains_exp(Conc, From),
    safe_subst_vbl(From, To, Conc, UpdatedConc),
    apply_relevant_updates(UpdatedConc,
                           T_UpdateKeyList,
                           NewConc,
                           T_HypNumberList).

% From above, variable not referenced in conclusion. Dismiss the composite
% update.
apply_relevant_updates(Conc,
                       [_H_UpdateKey | T_UpdateKeyList],
                       NewConc,
                       HypNumberList):-
    apply_relevant_updates(Conc,
                           T_UpdateKeyList,
                           NewConc,
                           HypNumberList).

%===============================================================================
% split_conjunction(+Exp, -ConjunctList).
%-------------------------------------------------------------------------------
% Split a conjunction Exp into its conjuncts ConjunctList.
%===============================================================================

split_conjunction(A and B, ConjunctList) :-
    split_conjunction(A, As),
    !,
    split_conjunction(B, Bs),
    !,
    append(As, Bs, ConjunctList).

split_conjunction(F, [F]).

%===============================================================================
% split_disjunction(+Exp, -DisjunctList).
%-------------------------------------------------------------------------------
% Split a disjunction Exp into its disjuncts DisjunctList.
%===============================================================================

split_disjunction(A or B, DisjunctList) :-
    split_disjunction(A, As),
    !,
    split_disjunction(B, Bs),
    !,
    append(As, Bs, DisjunctList).

split_disjunction(F, [F]).
%==============================================================================

%===============================================================================
% do_simplify_implications_and_equivalences.
%-------------------------------------------------------------------------------
% Simplify implications and equivalences at the current goal.
%===============================================================================

do_simplify_implications_and_equivalences :-
    get_hyp(A -> B, x, N),
    \+ log_fact(forwardchain2, [N, _, B]),
    infer(A, Hs),
    update_implication(N),
    assert_log_fact(forwardchain2, [N, Hs, B]),
    fail.

do_simplify_implications_and_equivalences :-
    get_hyp(A <-> B, x, N),
    \+ log_fact(forwardchain2, [N, _, B]),
    infer(A, Hs),
    \+ is_in(N, Hs),
    update_equivalence(x, N, A),
    assert_log_fact(forwardchain2, [N, Hs, B]),
    fail.

do_simplify_implications_and_equivalences :-
    get_hyp(A <-> B, x, N),
    \+ log_fact(forwardchain2, [N, _, A]),
    infer(B, Hs),
    \+ is_in(N, Hs),
    update_equivalence(x, N, B),
    assert_log_fact(forwardchain2, [N, Hs, A]),
    fail.

do_simplify_implications_and_equivalences:-
    !.

%===============================================================================
% try_to_discharge_goals_to_depth(+Depth).
%-------------------------------------------------------------------------------
% Try to prove the goal at depth Depth.
%===============================================================================

try_to_discharge_goals_to_depth(Depth) :-
    % Always succeeds.
    try_to_prove_subgoal_concs(Depth),
    % Only succeeds if all conclusions have been proved.
    proved_all_subgoal_conclusions,
    !.

try_to_discharge_goals_to_depth(Depth) :-
    % reached depth limit, so stop (by failing)
    Depth =< 0,
    !,
    fail.

try_to_discharge_goals_to_depth(Depth) :-
    % Explore subgoals at a deeper depth.
    NewDepth is Depth-1,
    (
       get_conc(for_all(Var:Type, Prop), x, ConcNumber),
       \+ get_proved_conc(ConcNumber),
       !,
       do_quantification_proof_or_fail(NewDepth, ConcNumber, Var, Type, Prop)
    ;
       % Inspect the conclusion, looking for an inequality that suggests a
       % case split which is likely to advance proof.
       get_conc(Conc, x, ConcNumber),
       \+ get_proved_conc(ConcNumber),
       is_inequality_with_updates(Conc, CasesList),
       !,
       do_cases_proof_or_fail(NewDepth, by_cases, ConcNumber, Conc, CasesList)
    ),

    !,
    try_to_discharge_goals_to_depth(Depth),
    !.

%----------------------------------------------------------------------------

% try_to_prove_subgoal_concs(Depth) -- always succeeds.
try_to_prove_subgoal_concs(Depth) :-
    clear_up_could_and_could_not_infer_facts,
    get_conc(ActualConc, x, ConcNumber),
    (
       % Consider the actual conclusion.
       ConsiderConc = ActualConc
    ;
       % Consider standardised form of the actual conclusion, if different.
       get_conc(ConsiderConc, [s|_], ConcNumber),
       ConsiderConc \= ActualConc
    ;
       % Consider semi-standardised form of the actual conclusion, if
       % different.
       get_conc(ConsiderConc, ss, ConcNumber),
       ConsiderConc \= ActualConc
    ),
    \+ get_proved_conc(ConcNumber),
    try_to_prove_subgoal_conc(Depth, ConsiderConc, ConcNumber, ActualConc).

try_to_prove_subgoal_concs(_Depth) :-
    !.

%----------------------------------------------------------------------------

% The following always fails, but updates state if conclusion is proved.
try_to_prove_subgoal_conc(Depth, ConsiderConc, ConcNumber, ActualConc) :-
    (
       % A direct contradiction has been found.
       get_hyp(false, _, H),
       Hs = [H]
    ;
       % Conclusion can be inferred.
       infer(ConsiderConc, Hs)
    ),
    % Log the proof and stop.
    add_proved_conc(ConcNumber),
    assert_log_fact(proved_subgoal, [ConcNumber, ConsiderConc, Hs, ActualConc, Depth]),
    !,
    fail.

%----------------------------------------------------------------------------

% Succeeds where all conclusions have been proved.
proved_all_subgoal_conclusions :-
    \+ (get_conc(_, _, ConcNumber), \+ get_proved_conc(ConcNumber)),
    !.

%===============================================================================
% do_quantification_proof_or_fail(+Depth, +ConcNumber, +Var, +Type, +Prop).
%-------------------------------------------------------------------------------
% Unwrap a universally quantified expression, and create a new subgoal.
%===============================================================================

% Predicate succeeds if and only if the proof is achieved.
do_quantification_proof_or_fail(Depth, ConcNumber, Var, Type, Prop) :-
    push_vc_state,
    assert_log_fact(unwrapping, [ConcNumber, Depth]),
    try_proof_by_unwrapping(Depth, ConcNumber, Var, Type, Prop),
    !,
    % Success.
    pop_vc_state(success),
    add_proved_conc(ConcNumber).

do_quantification_proof_or_fail(_Depth, _ConcNumber, _Var, _Type, _Prop) :-
    % From above, failure. Restore state.
    pop_vc_state(failure),
    !,
    fail.

%----------------------------------------------------------------------------

try_proof_by_unwrapping(Depth, ConcNumber, Var, Type, Prop) :-
    make_new_uvar(Var, Type, UniqVar),
    subst_vbl(Var, UniqVar, Prop, NewProp),
    prove_subgoal(Depth, ConcNumber, NewProp),
    !.

%----------------------------------------------------------------------------

% Introduce a new variable as UniqVar, with its name derived from Var and
% Type and the presence of previously introduced variables. For example:
% Var=myvariable, Type=integer, UniqVar=int_myvariable_1
% Var=a,          Type=t,       UniqVar=t_a_1
make_new_uvar(Var, Type, UniqVar) :-
    curtailType(Type, CurtailType),

    % Assemble the prefix for the unique name.
    atom_concat(CurtailType, '_', CurtailTypeUnderBar_Atom),
    atom_concat(CurtailTypeUnderBar_Atom, Var, CurtailTypeUnderBarVar_Atom),
    atom_concat(CurtailTypeUnderBarVar_Atom, '_', Prexix_Atom),
    !,

    % Seek a uniq number for this prefix.
    repeat,
    nextnumber(Prexix_Atom, NumberInt),
    integer_to_atom(NumberInt, NumberAtom),
    atom_concat(Prexix_Atom, NumberAtom, UniqVar),
    nondeclared(UniqVar),

    % Found uniq name. Externally record this new item alongside its new
    % core type.
    find_core_type(Type, CoreType),
    assertz(var_const(UniqVar, CoreType, p)),
    !.

%----------------------------------------------------------------------------

curtailType(Type, CurtailType):-
    atom_chars(Type, Type_CharList),
    curtailType_x(Type_CharList, CurtailType_CharList),
    atom_chars(CurtailType, CurtailType_CharList),
    !.

%----------------------------------------------------------------------------



curtailType_x([], []).
curtailType_x([AChar], [AChar]).
curtailType_x([AChar, BChar], [AChar, BChar]).
curtailType_x([AChar, BChar, CChar | _Rest_CharList], [AChar, BChar, CChar]).


%----------------------------------------------------------------------------

% Generate increasing numbers for namespace Atom, starting at 1.
nextnumber(Atom, NextInt) :-
    retract(current_root(Atom,PrevInt)),
    NextInt is PrevInt+1,
    asserta(current_root(Atom,NextInt)),
    !.

nextnumber(Atom, 1) :-
    asserta(current_root(Atom,1)),
    !.

%----------------------------------------------------------------------------

% Check Atom has not been declared already.
nondeclared(Atom) :-
    var_const(Atom, _, _),
    !,
    fail.

nondeclared(_Atom) :- !.

%===============================================================================
% post_rewrite_do_proof_or_fail(+Depth, +ConcNumber, +Conc, +NewConc, +HypNumberList).
%-------------------------------------------------------------------------------
% Describe a rewrite step in the logs, at the correct stack depth, and continue
% proof.
%===============================================================================

% Predicate succeeds if and only if the proof is achieved.
post_rewrite_do_proof_or_fail(Depth, ConcNumber, Conc, NewConc, HypNumberList) :-
    push_vc_state,
    assert_log_fact(composite_rewrite, [ConcNumber, Conc, HypNumberList]),
    prove_subgoal(Depth, ConcNumber, NewConc),
    !,
    % Success.
    pop_vc_state(success),
    add_proved_conc(ConcNumber).

post_rewrite_do_proof_or_fail(_Depth, _ConcNumber, _Conc, _NewConc, _HypNumberList) :-
    % From above, failure. Restore state.
    pop_vc_state(failure),
    !,
    fail.

%===============================================================================
% do_implication_proof_or_fail(+Depth, +ConcNumber, +Antecedent, +Consequent).
%-------------------------------------------------------------------------------
% Forward chain an implication, and create a new subgoal.
%===============================================================================

% Predicate succeeds if and only if the proof is achieved.
do_implication_proof_or_fail(Depth, ConcNumber, Antecedent, Consequent) :-
    push_vc_state,
    assert_log_fact(implies_conc, [ConcNumber, Antecedent, Consequent, Depth]),
    try_proof_by_forwardchain(Depth, ConcNumber, Antecedent, Consequent),
    !,
    % Success.
    pop_vc_state(success),
    add_proved_conc(ConcNumber).

do_implication_proof_or_fail(_Depth, _ConcNumber, _Antecedent, _Consequent) :-
    % From above, failure. Restore state.
    pop_vc_state(failure),
    !,
    fail.

%----------------------------------------------------------------------------

try_proof_by_forwardchain(Depth, ConcNumber, Antecedent, Consequent) :-
    prove_subgoal(Depth, ConcNumber, Antecedent -> Consequent),
    !.

%===============================================================================
% do_cases_proof_or_fail(+Depth, +ConcNumber, +Conc, +CasesList).
%-------------------------------------------------------------------------------
% Forward chain an implication, and create a new subgoal.
%===============================================================================

% Predicate succeeds if and only if the proof is achieved.
do_cases_proof_or_fail(Depth, Trigger, ConcNumber, Conc, CasesList) :-
    push_vc_state,
    assert_log_fact(Trigger, [ConcNumber, CasesList, Depth]),
    try_proof_by_cases(1, Depth, ConcNumber, Conc, CasesList),
    !,
    % Success.
    clear_up_could_and_could_not_infer_facts,
    pop_vc_state(success),
    add_proved_conc(ConcNumber).

do_cases_proof_or_fail(_Depth, _Trigger, _ConcNumber, _Conc, _CasesList) :-
    % From above, failure. Restore state.
    clear_up_could_and_could_not_infer_facts,
    pop_vc_state(failure),
    !,
    fail.

%----------------------------------------------------------------------------

try_proof_by_cases(_CaseNumber, _Depth, _ConcNumber, _Conc, []) :-
    !.

% Do not need to reset the vc state for the first case, as the state is
% initially clean.
try_proof_by_cases(1, Depth, ConcNumber, Conc, [Case|CasesList]) :-
    !,
    noisily_add_new_hyp_list([Case], by_cases(1), Depth),
    handle_cases_proof(1, Depth, ConcNumber, Conc, Case, CasesList).

% Do need to reset the vc state for all subsequent cases.
try_proof_by_cases(CaseNumber, Depth, ConcNumber, Conc, [Case|CasesList]) :-
    !,
    % Reset the vc state, so ready to start subsequent case.
    pop_vc_state(cases),
    push_vc_state,
    noisily_add_new_hyp_list([Case], by_cases(CaseNumber), Depth),
    handle_cases_proof(CaseNumber, Depth, ConcNumber, Conc, Case, CasesList).

%----------------------------------------------------------------------------

% Two cases: either Hs contain a contradiction from the cases, or prove the C

handle_cases_proof(CaseNumber, Depth, ConcNumber, Conc, Case, CasesList) :-
    clear_up_could_and_could_not_infer_facts,
    contradiction_in_hypotheses_from_cases(Case, ConcNumber),
    !,
    NextCaseNumber is CaseNumber+1,
    try_proof_by_cases(NextCaseNumber, Depth, ConcNumber, Conc, CasesList),
    !.

handle_cases_proof(CaseNumber, Depth, ConcNumber, Conc, _Case, CasesList) :-
    clear_up_could_and_could_not_infer_facts,
    simplify(Conc, NewConc),
    !,
    prove_subgoal(Depth, ConcNumber, NewConc),
    !,
    NextCaseNumber is CaseNumber+1,
    try_proof_by_cases(NextCaseNumber, Depth, ConcNumber, Conc, CasesList),
    !.

%----------------------------------------------------------------------------

% Conduct targeted contradiction searches, based on the form of cases that
% are expected to be considered.
contradiction_in_hypotheses_from_cases(X = Y, ConcNumber) :-
    infer(X <> Y, Hs),
    !,
    (
       get_hyp(X = Y, _, HypNumber),
       merge_sort([HypNumber], Hs, HL)
    ;
       HL = Hs
    ),
    !,
    assert_log_fact(contradiction, ['case-exclusion', HL]),
    !,
    add_proved_conc(ConcNumber),
    !.

contradiction_in_hypotheses_from_cases(X <> Y, ConcNumber) :-
    (
       find_empty_range(X <> Y, Hs)
    ;
       find_empty_range(Y <> X, Hs)
    ),
    !,
    assert_log_fact(contradiction, ['empty-range', Hs]),
    !,
    add_proved_conc(ConcNumber),
    !.

%----------------------------------------------------------------------------

find_empty_range(X <> Y, [Ha, Hb|Hs]) :-
    (
       get_hyp(L <= Y, _, Ha)
    ;
       get_hyp(Y >= L, _, Ha)
    ),
    (
       get_hyp(Y <= U, _, Hb)
    ;
       get_hyp(U >= Y, _, Hb)
    ),
    (
       is_an_empty_range(L, U),
       !,
       Hs = []
    ;
       is_non_empty_range(L, U),
       all_excluded(Y, X, L, U, Hs)
    ).

%----------------------------------------------------------------------------

is_an_empty_range(L, U) :-
    checktype(L, T),
    (
       T = integer,
       signed_integer(L),
       signed_integer(U),
       simplify(L>U, true)
    ;
       enumeration(T, EL),
       is_in(L, EL),
       is_in(U, EL),
       enumerated_simplify(L>U, true)
    ),
    !.

%----------------------------------------------------------------------------

% only succeed if at most 16 elements
is_non_empty_range(L, U) :-
    checktype(L, T),
    (
       T = integer,
       signed_integer(L),
       signed_integer(U),
       simplify(L<=U, true),
       simplify(U-L<16, true)
    ;
       enumeration(T, EL),
       is_in_with_pos(L, EL, PL),
       is_in_with_pos(U, EL, PU),
       PU - PL < 16,
       enumerated_simplify(L<=U, true)
    ),
    !.

%----------------------------------------------------------------------------

all_excluded(Y, X, L, U, Hs) :-
    is_excluded(Y, X, L, Ha),
    (
       L = U,
       !,
       Hs = Ha
    ;
       next_value_to_try(L, L1),
       all_excluded(Y, X, L1, U, Hb),
       merge_sort(Ha, Hb, Hs)
    ).

%----------------------------------------------------------------------------

is_excluded(Y, _X, L, Hs) :-
    infer(Y <> L, Hs),
    !.

is_excluded(_Y, L, L, _Hs) :-
    !.


%----------------------------------------------------------------------------

next_value_to_try(L, L1) :-
    checktype(L, T),
    (
       signed_integer(L),
       L1 iss L + 1
    ;
       enumeration(T, EL),
       enumerated_simplify(succ(L), L1),
       is_in(L1, EL)
    ),
    !.

%----------------------------------------------------------------------------


is_in_with_pos(Literal, Elements, Position) :-
    !,
    is_in_with_pos_from(0, Literal, Elements, Position).

%----------------------------------------------------------------------------

is_in_with_pos_from(Position, Literal, [Literal|_],  Position) :- !.
is_in_with_pos_from(Start,    Literal, [_|Elements], Position) :-
    New_Start is Start + 1,
    !,
    is_in_with_pos_from(New_Start, Literal, Elements, Position).

%===============================================================================
% prove_subgoal(+Depth, +ConcNumber, +ConcExp).
%-------------------------------------------------------------------------------
% Working at depth Depth, on a goal related to top level conclusion number
% ConcExp, and trying to prove ConcExp.
%===============================================================================

% Recursively move antecedents as hypotheses in place, without creating
% new subgoals.
prove_subgoal(Depth, ConcNumber, A -> B) :-
    !,
    assert_log_fact(add_imp_hyps, [Depth]),
    split_conjunction(A, As),
    noisily_add_new_hyp_list(As, ordinary, Depth),
    do_simplify_implications_and_equivalences,
    restructure_vc(Depth),
    simplify(B, NEW_B),
    (
       B = NEW_B
    ;
       assert_log_fact(simplified_conc, [ConcNumber, B, NEW_B, Depth])
    ),
    !,
    prove_subgoal(Depth, ConcNumber, NEW_B).

%----------------------------------------------------------------------------

% From above, ConcExp is not an implication. Create a subgoal to
% investigate this conclusion.
prove_subgoal(Depth, _ConcNumber, ConcExp) :-
    add_conc(ConcExp, x, M),
    assert_log_fact(new_goal, [M, ConcExp, Depth]),
    restructure_vc(Depth),
    !,
    impose_obvious_substitutions_at_depth(Depth),
    !,
    try_to_discharge_goals_to_depth(Depth).

%===============================================================================
% impose_obvious_substitutions_at_depth(+Depth).
%-------------------------------------------------------------------------------
% Working on subgoal at depth Depth, perform a collection of standard
% substitutions.
%===============================================================================

impose_obvious_substitutions_at_depth(Depth) :-
    retractall(know_eliminated_in_subgoaling(Depth, _)),
    do_obvious_substitutions_at_depth(Depth).

% always succeeds
impose_obvious_substitutions_at_depth(_Depth).

%-------------------------------------------------------------------------------

do_obvious_substitutions_at_depth(Depth) :-
    repeat,
    done_all_obvious_substitutions(Depth),
    !,
    fail.

%-------------------------------------------------------------------------------

% This predicate succeeds when no more substitutions are identified.

% Simplifier's proof strategy first performs all appropriate substitute and
% eliminate of the form n = ...
done_all_obvious_substitutions(Depth) :-
    substitution_elimination_is_on,
    equivalence_hyp(VAR, EXPRESSION, _X, N),
    \+ know_eliminated(N),
    \+ know_substituted(N),
    \+ know_eliminated_in_subgoaling(_, N),

    var_const(VAR, _, v),
    not_occurs_in(VAR, EXPRESSION),
    !,

    substitute_and_eliminate(subst_and_elim, user_rule_no, Depth, N, VAR, EXPRESSION).

% The simplifier then performs all appropriate substitute and eliminate of
% the form fld_<NAME_1>(fld_<NAME_2>(....fld_<NAME_N>(VAR_1))) =
%                       fld_<NAME_1>(fld_<NAME_2>(....fld_<NAME_N>(VAR_1)))
% where VAR_1 is not in VAR_2 and VAR_1 is a var_const.
done_all_obvious_substitutions(Depth) :-
    substitution_elimination_is_on,
    equivalence_hyp(A_FieldRead_Term, B_FieldRead_Term, _X, N),
    \+ know_eliminated(N),
    \+ know_eliminated_in_subgoaling(_, N),
    \+ get_processed_hyp_with_field_op(N),
    \+ get_processed_hyp_with_field_op_in_subgoal(_, N),
    \+ know_substituted(N),
    matching_records(A_FieldRead_Term, _, v, B_FieldRead_Term),
    !,

    substitute_and_eliminate(subst_fld, user_rule_no, Depth, N, A_FieldRead_Term, B_FieldRead_Term).

done_all_obvious_substitutions(Depth) :-
    substitution_elimination_is_on,
    (
       get_hyp((not VAR) <-> EXP, X, N)
    ;
       get_hyp(EXP <-> (not VAR), X, N)
    ),

    var_const(VAR, _, v),
    \+ know_eliminated(N),
    \+ know_substituted(N),
    \+ know_eliminated_in_subgoaling(_, N),
    not_occurs_in(VAR, EXP),
    simplify(not EXP, EXPRESSION),
    !,

    substitute_and_eliminate(subst_and_elim, user_rule_no, Depth, N, VAR, EXPRESSION).

done_all_obvious_substitutions(Depth) :-
    substitution_elimination_is_on,
    get_hyp(BOOL_ATOM, _X, N),
    var_const(BOOL_ATOM, boolean, v),
    \+ know_eliminated(N),
    \+ know_substituted(N),
    \+ know_eliminated_in_subgoaling(_, N),
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, Depth, N, BOOL_ATOM, true).

done_all_obvious_substitutions(Depth) :-
    substitution_elimination_is_on,
    get_hyp(not BOOL_ATOM, _X, N),
    var_const(BOOL_ATOM, boolean, v),
    \+ know_eliminated(N),
    \+ know_substituted(N),
    \+ know_eliminated_in_subgoaling(_, N),
    !,
    substitute_and_eliminate(subst_and_elim, user_rule_no, Depth, N, BOOL_ATOM, false).

done_all_obvious_substitutions(_Depth) :-
    % true when code reaches here.
    !.

%-------------------------------------------------------------------------------

equivalence_hyp(A_Term, B_Term, X, N) :-
    get_hyp(A_Term = B_Term, X, N).

equivalence_hyp(A_Term, B_Term, X, N) :-
    get_hyp(B_Term = A_Term, X, N).

equivalence_hyp(A_Term, B_Term, X, N) :-
    get_hyp(A_Term <-> B_Term, X, N).

equivalence_hyp(A_Term, B_Term, X, N) :-
    get_hyp(B_Term <-> A_Term, X, N).

%-------------------------------------------------------------------------------

not_occurs_in(VAR, VAR) :- !, fail.

not_occurs_in(VAR, ATOM) :-
    atom(ATOM),
    !,
    ATOM \= VAR,
    !.

not_occurs_in(VAR, EXPR) :-
    nonvar(EXPR),
    EXPR =.. [_OP|ARGS],
    !,
    not_occurs_in_list(VAR, ARGS),
    !.

%-------------------------------------------------------------------------------

not_occurs_in_list(VAR, [VAR|_]) :- !, fail.

not_occurs_in_list(VAR, [HEAD|TAIL]) :-
    not_occurs_in(VAR, HEAD),
    !,
    not_occurs_in_list(VAR, TAIL),
    !.

not_occurs_in_list(_, []) :- !.

%===============================================================================
% is_inequality_with_updates(+Exp, -CasesList).
%-------------------------------------------------------------------------------
% The input expression Exp is investigated, seeking to identify a list of
% cases for a proof by cases, that is likely to be successful.  The
% heuristic triggers on inequalities that reference updated structures,
% suggesting corresponding cases, enabling the updates to be simplified in
% each case.
%===============================================================================

is_inequality_with_updates(LExp and _RExp, CasesList) :-
    % It is assumed that the cases that would be suggested by 'LExp' are
    % the same as the cases that would be suggested by 'RExp'. This is
    % typically valid, due to the structures generated by the examiner. The
    % assumption may not hold for structures introduced by user proof
    % assertions - having the acceptable consequence of suggesting poor
    % case selections that will not ease proof.
    is_inequality_with_updates(LExp, CasesList).

is_inequality_with_updates(LExp <= RExp, CasesList) :-
    find_update_cases(LExp, RExp, CasesList),
    !.

is_inequality_with_updates(LExp >= RExp, CasesList) :-
    find_update_cases(LExp, RExp, CasesList),
    !.

is_inequality_with_updates(LExp < RExp, CasesList)  :-
    find_update_cases(LExp, RExp, CasesList),
    !.

is_inequality_with_updates(LExp > RExp, CasesList)  :-
    find_update_cases(LExp, RExp, CasesList),
    !.

is_inequality_with_updates(LExp = RExp, CasesList)  :-
    find_update_cases(LExp, RExp, CasesList),
    !.

is_inequality_with_updates(LExp <> RExp, CasesList) :-
    find_update_cases(LExp, RExp, CasesList),
    !.

%----------------------------------------------------------------------------

% Look for update cases suggested by either the left or right hand side of
% the deconstructed inequality expression.
find_update_cases(LExp, _RExp, CasesList) :-
    find_an_update_case(LExp, CasesList).

find_update_cases(_LExp, RExp, CasesList) :-
    find_an_update_case(RExp, CasesList).

%----------------------------------------------------------------------------

% Disregard atomic structures early, for performance.
find_an_update_case(X, _) :-
    atomic(X),
    !,
    fail.

% Target one step updated array element. Cases are only suggested where
% these are not directly provable in the current goal context.
find_an_update_case(element(update(_, [I], _), [J]), [I=J, I<>J]) :-
    cant_show_equal_or_not(I, J).

% Target two step updated array element. Cases are only suggested where
% these are not directly provable in the current goal context.
find_an_update_case(update(update(_, [I], _), [J], _), [I=J, I<>J]) :-
    cant_show_equal_or_not(I, J).

% Search deeper within expressions.
find_an_update_case(X, CASES) :-
    X =..[_OP|ARGS],
    find_an_update_case_in_list(ARGS, CASES).

%----------------------------------------------------------------------------

find_an_update_case_in_list([H|_], CASES) :-
    find_an_update_case(H, CASES).

find_an_update_case_in_list([_|T], CASES) :-
    find_an_update_case_in_list(T, CASES).

%----------------------------------------------------------------------------

cant_show_equal_or_not(I, J) :-
    infer(I=J),
    !,
    fail.

cant_show_equal_or_not(I, J) :-
    infer(I<>J),
    !,
    fail.

cant_show_equal_or_not(_I, _J) :-
    !.

%===============================================================================
% is_targeted_disjunction(+Exp, -DisjunctList).
%-------------------------------------------------------------------------------
% The input expression Exp is investigated, seeking to identify a list of
% cases from a disjunction.
%===============================================================================

is_targeted_disjunction(Exp, DisjunctList):-
    split_disjunction(Exp, DisjunctList),
    length(DisjunctList, CountInt),

    % Must be at least two.
    CountInt >= 2,

    % Must be less than (or exactly) the max .
    max_disjuncts(MaxDisjuncts),
    CountInt =< MaxDisjuncts,
    !.

%---------------------------------------------------------------------------

% Maximum number disjuncts considered is hard-coded. Experimentation suggests
% this is a good value.
max_disjuncts(16).
%===============================================================================

%===============================================================================
% restructure_vc(+Depth).
%-------------------------------------------------------------------------------
% Restructure and normalise the VC at depth Depth. The restructuring is
% targeted, based on the strategies considered for proof framing.
%===============================================================================

restructure_vc(Depth) :-
   movenots(Depth).

restructure_vc(Depth) :-
   split_hyps(Depth).

restructure_vc(Depth) :-
   split_concs(Depth).

restructure_vc(Depth) :-
   do_implication(Depth).

restructure_vc(Depth) :-
   equivalence(Depth).

restructure_vc(_Depth) :-
    !.

%-------------------------------------------------------------------------------

% MOVENOTS - move nots as far into expressions as possible.
movenots(Depth) :-
   retractall(hn(_)),
   assertz(hn(1)),
   repeat,
      hn(N),
      (
         gethyp(N,H),
         negin(H,H1),
         force_simplify(H1, H2),
         add_hyp_with_id(H2, x, N),
         log_negation_simplification(N, H, H2,Depth)
      ;
         true
      ),
      M is N+1,
      retract(hn(N)),
      assertz(hn(M)),
      bigger_than_all_hyps(M),
      !,
      fail.

%-------------------------------------------------------------------------------

bigger_than_all_hyps(M) :-
        get_hyp(_, _, N),
        N>=M,
        !,
        fail.

bigger_than_all_hyps(_) :-
    !.

%-------------------------------------------------------------------------------

force_simplify(X, Y) :-
        simplification_is_on,
        simplify(X, Y),
        !.

force_simplify(X, X) :- !.

%-------------------------------------------------------------------------------

% GETHYP(N,H) - instantiates H to the Nth hypothesis & retracts it.
gethyp(N,H) :-
   get_hyp(H, x, N),
   prune_hyp(H, x, N),
   !.

%-------------------------------------------------------------------------------

log_negation_simplification(_N, H, H, _D) :- !.
log_negation_simplification(N, _OLD, NEW, Depth) :-
        assert_log_fact(restructured, [N, NEW, Depth]),
        !.

%-------------------------------------------------------------------------------

% SPLIT_HYPS - split conjunction hypotheses into two or more hypotheses.
split_hyps(Depth) :-
   prune_hyp(A and B, x, N),
   add_hyp(A, x, Na),
   add_hyp(B, x, Nb),
   assert_log_fact(hyp_split, [N, [Na, A], [Nb, B], Depth]),
   !,
   % Try again in case either or A or B are also a conjunction
   split_hyps(Depth).

%-------------------------------------------------------------------------------

% SPLIT_CONCS - split conjunction conclusions into separate conclusions.
split_concs(Depth) :-
   prune_conc(A and B, x, N),
   prune_all_concs(_, _, N),
   add_conc(A, x, Na),
   add_conc(B, x, Nb),
   assert_log_fact(conc_split, [N, [Na, A], [Nb, B], Depth]),
   !,
   % Try again in case either or A or B are also a conjunction
   split_concs(Depth).

%-------------------------------------------------------------------------------

% DO_IMPLICATION - given "A" and "A -> B", add "B" as a hypothesis;
%                  given "not B" and "A -> B", add "not A" as a hypothesis.


do_implication(Depth) :-
   get_hyp(A -> B, x, Nab),
   get_hyp(A, x, Na),
   add_hyp(B, x, Nb),
   assert_log_fact(forwardchain, [Nab, Na, Nb, B, Depth]),
   fail.

do_implication(Depth) :-
   get_hyp(A -> B, x, Nab),
   get_hyp((not B), x, Nb),
   negin((not A),C),
   add_hyp(C, x, Na),
   assert_log_fact(backchain, [Nab, Nb, Na, C, Depth]),
   fail.

%-------------------------------------------------------------------------------

% EQUIVALENCE - given "A" and "A <-> B" or "B <-> A", add "B";
%               given "not A" and "A <-> B" or "B <-> A", add "not B"
equivalence(Depth) :-
   get_hyp(A <-> B, x, Nab),
   get_hyp(A, x, Na),
   add_hyp(B, x, Nb),
   assert_log_fact(forwardchain, [Nab, Na, Nb, B, Depth]),
   fail.

equivalence(Depth) :-
   get_hyp(A <-> B, x, Nab),
   get_hyp(B, x, Nb),
   add_hyp(A, x, Na),
   assert_log_fact(forwardchain, [Nab, Nb, Na, A, Depth]),
   fail.

equivalence(Depth) :-
   get_hyp(A <-> B, x, Nab),
   get_hyp(not(A), x, Na),
   negin(not(B),C),
   add_hyp(C, x, Nb),
   assert_log_fact(backchain, [Nab, Na, Nb, C, Depth]),
   fail.

equivalence(Depth) :-
   get_hyp(A <-> B, x, Nab),
   get_hyp(not(B), x, Nb),
   negin(not(A),C),
   add_hyp(C, x, Na),
   assert_log_fact(backchain, [Nab, Nb, Na, C, Depth]),
   fail.

%===============================================================================
% noisily_add_new_hyp_list(+HypList, +Means, +Depth).
%-------------------------------------------------------------------------------
% Add new hypotheses HypList, justified by Means, to the goal at depth
% Depth.
%===============================================================================

% Do not add true as a hypothesis.
noisily_add_new_hyp_list([true|Hs], Means, Depth) :-
    !,
    noisily_add_new_hyp_list(Hs, Means, Depth).

% Do not add a duplicate hypothesis.
noisily_add_new_hyp_list([H|Hs], Means, Depth) :-
    get_hyp(H,_,_),
    !,
    noisily_add_new_hyp_list(Hs, Means, Depth).

% Add a regular hypothesis.
noisily_add_new_hyp_list([H|Hs], ordinary, Depth) :-
    add_hyp(H, x, N),
    assert_log_fact(new_hyp, [N, H, Depth]),
    !,
    noisily_add_new_hyp_list(Hs, ordinary, Depth).

% Add a hypothesis, as part of a proof by cases.
noisily_add_new_hyp_list([H|Hs], by_cases(C), Depth) :-
    add_hyp(H, x, N),
    assert_log_fact(new_hyp_for_case, [N, H, C, Depth]),
    !,
    noisily_add_new_hyp_list(Hs, by_cases(C), Depth).

noisily_add_new_hyp_list([], _Means, _Depth).

%-------------------------------------------------------------------------------
% "The VC State Stack"
% --------------------
% The following facts are stored on the stack, as proof framing is used:
%   hyp(X, N, H)         -- hypotheses
%   conc(X, N, X)        -- conclusions
%   proved_conclusion(N) -- to retain which ones have already been proved
%   log_fact(X, Y)       -- log facts built up so far
%
% On entering a new proof-frame, these are all copied to the stack via a
% call to push_vc_state, which fetches the current stack depth
% (incrementing it as it does so) and asserts a set of stack(Depth, Fact)
% facts.
%
% The conclusions, proved_conclusion and log_fact facts are also all
% retracted, so they don't interfere with proof in the new proof frame.
% Only the hypotheses are retained.
%
% If the proof-frame proof attempt fails, we restore the VC state simply by
% calling pop_vc_state(failure), which does the following:
% - fetches the current stack depth, decrementing it as it does so;
% - retract all the current hypotheses, conclusions and proved_conclusion
%   facts;
% - moves the log_facts built up within the proof-frame into temporary
%   storage (via some moved_log_fact facts);
% - retracts each fact at the current depth from the stack in turn,
%   asserting it back into the database as it does so (to restore the
%   hypotheses, conclusions, proved_conclusions and log_facts from the
%   enclosing frame).
%
% If the proof-frame proof attempt succeeds, we do the same as the failure
% case above, but via pop_vc_state(success), which also does the following:
% - adds the new log facts from the proof frame we've just exited on to the
%   end of the log_fact facts, so these can get propagated back to the
%   enclosing proof frame into which we are now returning.
%
% Finally, in a proof-by-cases, after a successful proof of a case we call
% pop_vc_state(cases), which behaves like the success case, but buffers the
% case log-facts instead of restoring them immediately. Where the
% subsequent case is successful, the buffered (previous case) log-facts are
% moved to this case and appended to the state of the VC's proof. Where a
% case fails, all buffered and moved log-facts are discarded.  Since this
% failure will ripple upwards in any proof tree, this discarding behaviour
% also propagates upwards correctly.
%-------------------------------------------------------------------------------

%===============================================================================
% clear_up_stack_facts.
%-------------------------------------------------------------------------------
% Clear up the stack, to begin proving a new subgoal.
%===============================================================================

clear_up_stack_facts :-
    % do for each conclusion attempt.
    retractall(stack(_,_)),
    retractall(current_stack_depth(_)),
    retractall(moved_log_fact(_,_,_)),
    clear_up_could_and_could_not_infer_facts,
    !.

%===============================================================================
% push_vc_state.
%-------------------------------------------------------------------------------
% Place the current goal onto the stack, and leave a fresh subgoal.
%===============================================================================

push_vc_state :-
    fetch_and_increment_stack_depth(SD),
    do_push_vc(SD),
    !.

%-------------------------------------------------------------------------------

% Store the hypotheses, conclusions and log_facts on the stack. Also remove
% conclusions and log_facts, creating a fresh subgoal.
do_push_vc(SD) :-
    get_hyp(H, X, N),
    assertz(stack(SD, get_hyp(H, X, N))),
    fail.

do_push_vc(SD) :-
    get_next_hyp_id(NextHypId_Int),
    assertz(stack(SD, get_next_hyp_id(NextHypId_Int))),
    fail.

do_push_vc(SD) :-
    prune_conc(C, X, N),
    assertz(stack(SD, get_conc(C, X, N))),
    fail.

do_push_vc(SD) :-
    prune_proved_conc(N),
    assertz(stack(SD, get_proved_conc(N))),
    fail.

do_push_vc(SD) :-
    retract(log_fact(X, Y)),
    assertz(stack(SD, log_fact(X, Y))),
    fail.

do_push_vc(_) :-
    !.

%-------------------------------------------------------------------------------

fetch_and_increment_stack_depth(SD) :-
    retract(current_stack_depth(N)),
    SD is N+1,
    asserta(current_stack_depth(SD)),
    !.

fetch_and_increment_stack_depth(1) :-
    asserta(current_stack_depth(1)),
    !.

%===============================================================================
% pop_vc_state(+PopKind).
%-------------------------------------------------------------------------------
% Pop off the top goal from the stack.
%===============================================================================

pop_vc_state(_Any) :-
    fetch_and_decrement_stack_depth(SD),
    prune_all_hyps(_, _, _),
    reset_next_hyp_id,
    prune_all_concs(_, _, _),
    prune_all_proved_concs,

    move_logfacts(SD),
    retract(stack(SD, FACT)),
    assertz(FACT),
    % Force backtracking.
    fail.

pop_vc_state(success) :-
    current_stack_depth(SD),
    promote_moved_logfacts(SD),
    fail.

pop_vc_state(failure) :-
    current_stack_depth(SD),
    PrevSD is SD + 1,
    % discard buffered dead-end log-facts
    retractall(moved_log_fact(PrevSD,_,_)),
    fail.

pop_vc_state(_Any) :-
    % including the 'cases' case
    !.

%----------------------------------------------------------------------------

move_logfacts(SD) :-
    retract(log_fact(X, Y)),
    assertz(moved_log_fact(SD, X, Y)),
    fail.

move_logfacts(_SD) :- !.

%----------------------------------------------------------------------------

promote_moved_logfacts(SD) :-
    PrevSD is SD + 1,
    retract(moved_log_fact(PrevSD, X, Y)),
    assert_log_fact(X, Y),
    fail.

promote_moved_logfacts(_SD) :-
    % when none left to move at depth PrevSD
    !.

%----------------------------------------------------------------------------

fetch_and_decrement_stack_depth(SD) :-
    retract(current_stack_depth(SD)),
    N is SD-1,
    !,
    asserta(current_stack_depth(N)),
    !.

%===============================================================================
% substitute_and_eliminate(+Strategy, +UserRule, +Depth, +N, +V, +E).
%-------------------------------------------------------------------------------
% Perform substitute and eliminate, seeking to simplify the goal without
% undermining its overall provability.
% Parameter UserRule (user_rules_no, user_rules_yes(File:RuleId) specifies whether the
% substitution is based on a user defined rule.
%===============================================================================

substitute_and_eliminate(_Strategy, _, _, _, _, _) :-
    retractall(potential_subst_fact(_, _)),
    fail.

substitute_and_eliminate(_Strategy, UserRules, Depth, N, V, E) :-
    get_hyp(H, X, K),
    K \= N,
    \+ know_eliminated(K),
    \+ know_eliminated_in_subgoaling(_, K),
    \+ get_processed_hyp_with_field_op(K),
    \+ get_processed_hyp_with_field_op_in_subgoal(_, K),
    subst_vbl(V, E, H, S),
    H \= S,
    simplify_if_allowed(S, S1),
    H \= S1,
    update_substituted_hyp(Depth, X, K, S1),
    substitute_and_eliminate_mark_user_rules(UserRules, hyp(K)),
    fail.

substitute_and_eliminate(_Strategy, UserRules, Depth, _N, V, E) :-
    get_conc(C, X, K),
    \+ get_proved_conc(K),
    do_subst_and_simplify_conc(V, E, C, S),
    C \= S,
    update_substituted_conc(Depth, X, K, S),
    substitute_and_eliminate_mark_user_rules(UserRules, conc(K)),
    fail.

substitute_and_eliminate(_Strategy, _UserRules, Depth, N, V, E) :-
    path_functions,
    !,
    assertz(know_substituted(N)),
    potential_subst_fact(_, _),
    !,
    % There is no need to write different log records for
    % "substitute and eliminate hypothesis a var/const" and "substitute
    % an unchanged record field" as the log messages for path_functions
    % is appropriate for both cases - unlike case when \+path_functions.
    assert_log_fact(substituted, [Depth, N, V, E]),
    copy_subst_facts_to_log,
    fail.

substitute_and_eliminate(Strategy, UserRules, Depth, N, V, E) :-
    potential_subst_fact(_, _),
    !,
    substitute_and_eliminate_potential_subst_fact(Strategy, Depth, N, V, E),
    substitute_and_eliminate_mark_user_rules(UserRules, N),
    !,
    fail.

substitute_and_eliminate(Strategy, UserRules, Depth, N, V, _E) :-
    % Ignore redundant rule applications.
    integer(N),
    !,
    substitute_and_eliminate_integer(Strategy, Depth, N, V),
    substitute_and_eliminate_mark_user_rules(UserRules, N),
    !,
    fail.

%-------------------------------------------------------------------------------

substitute_and_eliminate_mark_user_rules(user_rule_yes(File:RuleId), ConcOrHyp_N):-
    is_conc_or_hyp(ConcOrHyp_N),
    mark_whether_proved_by_user_rules(user_rewrite_rule),
    add_to_rule_summary(File:RuleId, ConcOrHyp_N),
    !.

substitute_and_eliminate_mark_user_rules(_, _):-
    !.

is_conc_or_hyp(hyp(_N)).

is_conc_or_hyp(conc(_N)).

%-------------------------------------------------------------------------------

substitute_and_eliminate_potential_subst_fact(subst_and_elim, Depth, N, V, E) :-
    substitute_and_eliminate_x(Depth, N),
    assert_log_fact(substituted, [Depth, N, V, E]),
    copy_subst_facts_to_log.

substitute_and_eliminate_potential_subst_fact(subst_fld, Depth, N, V, E) :-
    substitute_and_eliminate_y(Depth, N),
    assert_log_fact(substituted_fld, [Depth, N, V, E]).

%-------------------------------------------------------------------------------

substitute_and_eliminate_integer(subst_and_elim, Depth, N, V) :-
    substitute_and_eliminate_x(Depth, N),
    assert_log_fact(subst_elim_hyp, [Depth, N, V]).

substitute_and_eliminate_integer(subst_fld, Depth, N, V) :-
    substitute_and_eliminate_y(Depth, N),
    assert_log_fact(subst_fld, [Depth, N, V]).

%-------------------------------------------------------------------------------

substitute_and_eliminate_x(Depth, N) :-
    Depth=toplevel,
    assertz(know_eliminated(N)),
    issue_substitution_message(N).

substitute_and_eliminate_x(Depth, N) :-
    assertz(know_eliminated_in_subgoaling(Depth, N)).

%-------------------------------------------------------------------------------

substitute_and_eliminate_y(Depth, N) :-
    Depth=toplevel,
    add_processed_hyp_with_field_op(N),
    issue_substitution_message(N).

substitute_and_eliminate_y(Depth, N) :-
    add_processed_hyp_with_field_op_in_subgoal(Depth, N).

%-------------------------------------------------------------------------------

do_subst_and_simplify_conc(V, E, C1 & C2, S1 & S2) :-
    !,
    do_subst_and_simplify_conc(V, E, C1, S1),
    !,
    do_subst_and_simplify_conc(V, E, C2, S2),
    !.

do_subst_and_simplify_conc(V, E, X := Y, X := Z) :-
    !,
    do_subst_and_simplify_conc(V, E, Y, Z),
    !.

do_subst_and_simplify_conc(V, E, C, S) :-
    !,
    subst_vbl(V, E, C, S1),
    !,
    (
       simplification_is_on,
       % subst_vbl has done something, so simplify.
       C \= S1,
       simplify(S1, S)
    ;
       simplification_is_on,
       % subst_vbl no effect, so no need to simplify.
       C = S1,
       S = S1
    ;
       \+ simplification_is_on,
       S = S1
    ),
    !.

%-------------------------------------------------------------------------------

update_substituted_hyp(Depth, X, K, S1) :-
    replace_hyp(_Old_Hyp, X, K, S1),
    complexity_token(X, XX),
    retractall(complexity_fact(hyp, K, XX, _)),
    complexity(S1, K, hyp, XX, _),
    (
       X = x,
       assertz(potential_subst_fact(subst_hyp, [Depth, K, S1]))
    ;
       true
    ),
    !.

%-------------------------------------------------------------------------------

update_substituted_conc(Depth, X, K, S) :-
    prune_conc(_, X, K),
    (
       X = [s,T], XX = s,
       norm_typed_expr(S, boolean, SS)
    ;
       X = ss, XX = ss,
       is_relational_expression(S, Rop, A, B, T),
       norm_typed_expr(A, T, AA),
       norm_typed_expr(B, T, BB),
       SS =.. [Rop, AA, BB]
    ;
       XX = X,
       SS = S
    ),
    !,
    add_conc_with_id(SS, X, K),
    (
       X = x,
       assertz(potential_subst_fact(subst_conc, [Depth, K, SS]))
    ;
       true
    ),
    retractall(complexity_fact(conc, K, XX, _)),
    complexity(SS, K, conc, XX, _),
    !.

%-------------------------------------------------------------------------------

simplify_if_allowed(X, Y) :-
    simplification_is_on,
    !,
    simplify(X, Y),
    !.
simplify_if_allowed(X, X) :- !.


%-------------------------------------------------------------------------------

copy_subst_facts_to_log :-
    retract(potential_subst_fact(X, Y)),
    assert_log_fact(X, Y),
    fail.

copy_subst_facts_to_log :- !.

%###############################################################################
% State private to module.
%###############################################################################

%===============================================================================
% Private state:
%   get_processed_hyp_with_field_op('HypId_Int')).
%   get_processed_hyp_with_field_op_in_subgoal('Level_Int', 'HypId_Int')).
%-------------------------------------------------------------------------------
% These state record which hypothesis containing equality between
% the same fields (nested to arbitrary depth) of two variables has
% been processed by the Simplifier to ensure termination. The use of these
% state mirrors the state know_eliminated and know_eliminated_in_subgoal
% when processing hypothesis containing equality containing a variable or
% constant.
%===============================================================================

:- dynamic(get_processed_hyp_with_field_op/1).
:- dynamic(get_processed_hyp_with_field_op_in_subgoal/2).

%===============================================================================
% add_processed_hyp_with_field_op(+HypId_Int)
%-------------------------------------------------------------------------------
% Add HypId_Int into the database to record that the simplifier has processed
% the hypothesis where the hypothesis defines properties on variable or
% constant that are nested inside functions - e.g. f1(x) = f2(y) and
% f1(g1(x)) = f2(g2(y)).
%===============================================================================

add_processed_hyp_with_field_op(HypId_Int) :-
    assert(get_processed_hyp_with_field_op(HypId_Int)).

%===============================================================================
% prune_all_processed_hyp_with_field_op
%-------------------------------------------------------------------------------
% Retracts all hypothesis identifiers in get_processed_hyp_with_field_op.
%===============================================================================

prune_all_processed_hyp_with_field_op :-
    retractall(get_processed_hyp_with_field_op(_)).

%###############################################################################
% get_processed_hyp_with_field_op_in_subgoal
%###############################################################################

%===============================================================================
% add_processed_hyp_with_field_op_in_subgoal(+Level_Int, +HypId_Int)
%-------------------------------------------------------------------------------
% Add hypothesis identifier and level into
% get_processed_hyp_with_field_op_in_subgoal.
% Similar to get_processed_hyp_with_field_op, the hypothesis defines properties on
% variables and constants nested inside functions.


%===============================================================================

add_processed_hyp_with_field_op_in_subgoal(Level_Int, HypId_Int) :-
    assert(get_processed_hyp_with_field_op_in_subgoal(Level_Int, HypId_Int)).

%===============================================================================
% prune_all_processed_hyp_with_field_op_in_subgoal
%-------------------------------------------------------------------------------
% Retracts all hypothesis identifiers from
% get_processed_hyp_with_field_op_in_subgoal.
%===============================================================================

prune_all_processed_hyp_with_field_op_in_subgoal:-
    retractall(get_processed_hyp_with_field_op_in_subgoal(_, _)).

%###############################################################################
% END-OF-FILE
