% -----------------------------------------------------------------------------
%  (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 predicates to performs the simplification and outputting of
% vcs. This ties together code for the purposes of refactoring and is a
% strong candidate for post-refactoring work.
%###############################################################################





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

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

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

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

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

%===============================================================================
% perform_simplification.
%-------------------------------------------------------------------------------
% VCG loading is weaved with simplification, echoing of output, and final
% output. This new predicate tries to reorganise these.
%===============================================================================


% There is a only a small amount of shared code between vcs and path
% functions. Just consider these separately.

perform_simplification(SimplifiedVcgFile_Stream) :-
    get_provenance_proof_file_kind(verification_conditions),
    perform_simplification_verification_conditions(SimplifiedVcgFile_Stream),
    !.

% A dpc file contains a set of VCs where each VC has one "false" conclusion.
% The Simplifier searches for dead paths by trying to prove each VC and a
% a dead path exists if the proof is successful - only way a VC can be
% true when the conclusion is "false" is if the hypothesis infers "false".

perform_simplification(SummaryDpcFile_Stream) :-
    get_provenance_proof_file_kind(deadpath_search),
    % Change this to corresponding siv's dpc equivalent (if any).
    perform_simplification_verification_conditions(SummaryDpcFile_Stream),
    !.



perform_simplification(SimplifiedVcgFile_Stream) :-
    get_provenance_proof_file_kind(path_functions),
    perform_simplification_path_functions(SimplifiedVcgFile_Stream),
    !.



%===============================================================================
% perform_simplification_verification_conditions(+SimplifiedVcgFile_Stream).
%-------------------------------------------------------------------------------
% Simplify verification conditions.
%===============================================================================

perform_simplification_verification_conditions(SimplifiedVcgFile_Stream):-
    repeat,
    perform_simplification_verification_conditions_x(SimplifiedVcgFile_Stream),
    !.

perform_simplification_verification_conditions_x(SimplifiedVcgFile_Stream):-
    % Retrieve the next vc to process.
    retrieve_next_vcg,

    % Get details for this vc.
    get_vcg_vc(VCId_Atom,
               Order_Int,
               _Name_Atom,
               _Number_Int,
               _ParentVCTraceId_Atom),

    % Record that at least one VC has been successfully recorded.
    record_vc_retrieved,




    tidy_up_vc_state,
    
    retractall(current_vc_number(_N)),
    assert(current_vc_number(Order_Int)),

    
    % Perform simplification.
    simplify_verification_conditions(SimplifiedVcgFile_Stream, VCId_Atom, Order_Int),

    (
       path_functions
    ;
       nl(SimplifiedVcgFile_Stream)
    ),
    !,
    fail.

% From above, no more VCs available.
% It is an error if zero VCs were encountered.
perform_simplification_verification_conditions_x(_SimplifiedVcgFile_Stream):-
    complain_if_zero_vcs_retrieved,
    !.

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

record_vc_retrieved:-
    \+ get_vcg_seen_vc,
    add_vcg_seen_vc,
    !.

record_vc_retrieved:-
    !.

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

complain_if_zero_vcs_retrieved:-
    get_vcg_seen_vc,
    !.

% From above, no vcs were retrieved.
complain_if_zero_vcs_retrieved:-
    show_error('No VCs found in parsing vcg file.\n', []).

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

simplify_verification_conditions(_SimplifiedVcgFile_Stream, VCId_Atom, Order_Int):-
    get_switch_typecheck_only(on),
    write('Type checking VC: '),
    write(Order_Int),
    hoist_vc_hypotheses(VCId_Atom, Order_Int),
    hoist_vc_conclusions(VCId_Atom, Order_Int),
    write(' - OK'), nl,
    flush_output,
    !.

simplify_verification_conditions(SimplifiedVcgFile_Stream, VCId_Atom, Order_Int):-
    get_switch_typecheck_only(off),
    refactor_write_vcs_top(SimplifiedVcgFile_Stream, Order_Int, VCId_Atom),
    hoist_vc_hypotheses(VCId_Atom, Order_Int),
    hoist_vc_conclusions(VCId_Atom, Order_Int),
    issue_message('', []),
    issue_message('Trying to simplify: ', VCId_Atom),
    simplify_vc,
    refactor_write_vcs(SimplifiedVcgFile_Stream, Order_Int, VCId_Atom),
    report_to_user(VCId_Atom),
    !.

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




hoist_vc_hypotheses(VCId_Atom, VC_Num):-
    get_vcg_hypothesis(Number_Int, Hyp_Term, VCId_Atom),
    prune_vcg_hypothesis(Number_Int, Hyp_Term, VCId_Atom),
    process_component(Hyp_Term, Number_Int, VC_Num, hyp),
    fail.

hoist_vc_hypotheses(_VCId_Atom, _VC_Num):-
    !.

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

hoist_vc_conclusions(VCId_Atom, VC_Num):-
    retract(get_vcg_conclusion(Number_Int, Conc_Term, VCId_Atom)),
    process_component(Conc_Term, Number_Int, VC_Num, conc),
    fail.

hoist_vc_conclusions(_VCId_Atom, _VC_Num):-
    !.



%===============================================================================
% perform_simplification_path_functions(+SimplifiedVcgFile_Stream).
%-------------------------------------------------------------------------------
% Simplify path functions.
%===============================================================================




perform_simplification_path_functions(SimplifiedVcgFile_Stream):-
    generate_integer(Order_Int),
    perform_simplification_path_functions_x(SimplifiedVcgFile_Stream, Order_Int),
    !.

perform_simplification_path_functions_x(SimplifiedVcgFile_Stream, Order_Int):-
    get_pfs_pf(PFId_Atom,
               Order_Int,
               _Number_Int,
               _ParentSuccessorStatementId_Atom),
    tidy_up_vc_state,

    retractall(current_vc_number(_N)),
    assert(current_vc_number(Order_Int)),
    simplify_path_functions(SimplifiedVcgFile_Stream, PFId_Atom, Order_Int),
    (
       path_functions
    ;
       nl(SimplifiedVcgFile_Stream)
    ),
    !,
    fail.

perform_simplification_path_functions_x(_SimplifiedVcgFile_Stream, _Order_Int):-
    !.

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

simplify_path_functions(_SimplifiedVcgFile_Stream, PFId_Atom, Order_Int):-
    get_switch_typecheck_only(on),
    write('Type checking path function: '),
    write(Order_Int),
    hoist_pf_traversal_conditions(PFId_Atom),
    spacer(8),
    hoist_pf_actions(PFId_Atom),
    write(' - OK'),
    flush_output,
    !.

simplify_path_functions(SimplifiedVcgFile_Stream, PFId_Atom, Order_Int):-
    get_switch_typecheck_only(off),
    refactor_write_vcs_top(SimplifiedVcgFile_Stream, Order_Int, PFId_Atom),
    hoist_pf_traversal_conditions(PFId_Atom),
    spacer(8),
    hoist_pf_actions(PFId_Atom),
    simplify_vc,
    refactor_write_vcs(SimplifiedVcgFile_Stream, Order_Int, PFId_Atom),
    report_to_user(PFId_Atom),
    !.



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

hoist_pf_traversal_conditions(PFId_Atom):-
    get_pfs_traversal_condition(_Number_Int, TravCond_Term, PFId_Atom),
    hoist_pf_traversal_conditions_x(TravCond_Term),
    fail.

hoist_pf_traversal_conditions(_PFId_Atom):-
    !.

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

hoist_pf_traversal_conditions_x(TravCond_Term):-
    restructure_formula(TravCond_Term, INTERMEDIATE),
    checkvalidtraversalconditiontype(INTERMEDIATE, SIMPLIFIED_CONDITION),
    !,
        (
         \+ get_hyp(SIMPLIFIED_CONDITION, _, _),
         !,
         add_hyp(SIMPLIFIED_CONDITION, x, HYP_NO),
         log_simplification(hyp,HYP_NO,INTERMEDIATE,SIMPLIFIED_CONDITION)
         ;
         get_hyp(SIMPLIFIED_CONDITION, _, N),
         assert_log_fact(duplicate_hyp, [N, SIMPLIFIED_CONDITION])
         ),
    !.

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

checkvalidtraversalconditiontype(X, Y) :-
        checktype(X, boolean),
        !,
        (
           simplification_is_on,
           simplify(X, Y)
        ;
           Y = X
        ),
        !.
checkvalidtraversalconditiontype(_, _) :-
        stopwith('Above traversal condition does not typecheck correctly.'),
        !.

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

hoist_pf_actions(PFId_Atom):-
    get_pfs_action(Action_Term, PFId_Atom),
    hoist_pf_actions_x(Action_Term),
    fail.

hoist_pf_actions(_VCId_Atom):-
    !.

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

hoist_pf_actions_x(Action_Term):-
    retractall(simplified_action_part),
    checkvalidactiontype(Action_Term, SIMPLIFIED_ACTION),
    !,
        (
         simplified_action_part,
         assert_log_fact(simplified, [conc,1,Action_Term,SIMPLIFIED_ACTION])
         ;
         true
         ),
    !,
    add_conc(SIMPLIFIED_ACTION, x, _).

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

checkvalidactiontype(X & Y, A & B) :-
        checkvalidactiontype(X, A),
        !,
        checkvalidactiontype(Y, B),
        !.

checkvalidactiontype(X := Y, X := Z) :-
        atom(X),
        !,
        (
           checktype(X, T)
        ;
           stopwith3('Undeclared identifier ', X, ' on l.h.s. of ":=" in above action.')
        ),
        !,
        (
           restructure_formula(Y, Z1),
           checktype(Z1, T)
        ;
           stopwith3('Type of r.h.s. of ":=" does not match that of l.h.s. [',
                     X, '] in above')
        ),
        !,
        (
           simplification_is_on,
           simplify(Z1, Z),
           (
              simplified_action_part
           ;
              Z \= Z1,
              assertz(simplified_action_part)
           ;
              true
           )
        ;
           Z = Z1
        ),
        !.
checkvalidactiontype(unit(function),[]) :- !.

checkvalidactiontype(null,[]) :- !.






:- dynamic(have_seen/1).
:- dynamic(pfs_format/1).

%===============================================================================
% refactor_write_vcs_top(+SimplifiedVcgFile_Stream, +Order_Int, +Id_Atom).
%===============================================================================
% Display the header part of verification conditions or path function.
%===============================================================================

refactor_write_vcs_top(SimplifiedVcgFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(verification_conditions),
    write_before_vc_banner(SimplifiedVcgFile_Stream, Order_Int, Id_Atom),
    !.

refactor_write_vcs_top(SummaryDpcFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(deadpath_search),
    write_before_vc_banner(SummaryDpcFile_Stream, Order_Int, Id_Atom),
    !.

% DELETE_PATH_FUNCTIONS

refactor_write_vcs_top(SimplifiedVcgFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(path_functions),
    write_before_pf_banner(SimplifiedVcgFile_Stream, Order_Int, Id_Atom),
    !.

% END_DELETE_PATH_FUNCTIONS

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

write_before_vc_banner(SimplifiedVcgFile_Stream, Order_Int, VCId_Atom):-
    get_vcg_vc(VCId_Atom, Order_Int, Name_Atom, _Number_Int, ParentVCTraceId_Atom),
    get_vcg_trace(ParentVCTraceId_Atom, VCTrace),
    maybe_echo_vc_trace(SimplifiedVcgFile_Stream, ParentVCTraceId_Atom, VCTrace),
    write(SimplifiedVcgFile_Stream, Name_Atom),
    write(SimplifiedVcgFile_Stream, '.'),
    nl(SimplifiedVcgFile_Stream),
    !.

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

maybe_echo_vc_trace(_SimplifiedVcgFile_Stream, ParentVCTraceId_Atom, _VCTrace):-
   have_seen(ParentVCTraceId_Atom),
    !.

maybe_echo_vc_trace(SimplifiedVcgFile_Stream, ParentVCTraceId_Atom, VCTrace):-
    echo_vc_trace(SimplifiedVcgFile_Stream, VCTrace),
    nl(SimplifiedVcgFile_Stream),
    nl(SimplifiedVcgFile_Stream),
    assert(have_seen(ParentVCTraceId_Atom)),
    !.

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

echo_vc_trace(SimplifiedVcgFile_Stream, fudge(Line)):-
    write(SimplifiedVcgFile_Stream, Line),
    !.

echo_vc_trace(SimplifiedVcgFile_Stream, checkRefinementIntegrity):-
    write(SimplifiedVcgFile_Stream, 'For checks of refinement integrity: '),
    !.

echo_vc_trace(SimplifiedVcgFile_Stream, subclassInheritanceIntegrity):-
    write(SimplifiedVcgFile_Stream, 'For checks of subclass inheritance integrity: '),
    !.

echo_vc_trace(SimplifiedVcgFile_Stream, traverseCutpoints(VCCutpointFrom, VCCutpointTo)):-
    write(SimplifiedVcgFile_Stream, 'For path(s) from '),
    echo_vc_trace_vccutpointfrom(SimplifiedVcgFile_Stream, VCCutpointFrom),
    write(SimplifiedVcgFile_Stream, ' to '),
    echo_vc_trace_vccutpointto(SimplifiedVcgFile_Stream, VCCutpointTo),
    write(SimplifiedVcgFile_Stream, ':'),
    !.

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

echo_vc_trace_vccutpointfrom(SimplifiedVcgFile_Stream, start):-
    write(SimplifiedVcgFile_Stream, 'start'),
    !.

echo_vc_trace_vccutpointfrom(SimplifiedVcgFile_Stream, assertion(AssertionKind, Line_Int)):-
    echo_vc_trace_assertionkind(SimplifiedVcgFile_Stream, AssertionKind),
    write(SimplifiedVcgFile_Stream, 'assertion of line '),
    write(SimplifiedVcgFile_Stream, Line_Int),
    !.

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

echo_vc_trace_assertionkind(SimplifiedVcgFile_Stream, userprovided):-
    write(SimplifiedVcgFile_Stream, ''),
    !.

echo_vc_trace_assertionkind(SimplifiedVcgFile_Stream, default):-
    write(SimplifiedVcgFile_Stream, 'default '),
    !.

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

echo_vc_trace_vccutpointto(SimplifiedVcgFile_Stream, finish):-
    write(SimplifiedVcgFile_Stream, 'finish'),
    !.

echo_vc_trace_vccutpointto(SimplifiedVcgFile_Stream, assertion(AssertionKind, Line_Int)):-
    echo_vc_trace_vccutpointfrom(SimplifiedVcgFile_Stream, assertion(AssertionKind, Line_Int)),
    !.

echo_vc_trace_vccutpointto(SimplifiedVcgFile_Stream, check(CheckKind, Line_Int)):-
    echo_vc_trace_checkkind(SimplifiedVcgFile_Stream, CheckKind),
    write(SimplifiedVcgFile_Stream, 'check associated with statement of line '),
    write(SimplifiedVcgFile_Stream, Line_Int),
    !.

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

echo_vc_trace_checkkind(_SimplifiedVcgFile_Stream, userprovided):-
    !.

echo_vc_trace_checkkind(SimplifiedVcgFile_Stream, runtime):-
    write(SimplifiedVcgFile_Stream, 'run-time '),
    !.

echo_vc_trace_checkkind(SimplifiedVcgFile_Stream, precondition):-
    write(SimplifiedVcgFile_Stream, 'precondition '),
    !.

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

write_before_pf_banner(SimplifiedVcgFile_Stream, Order_Int, PFId_Atom):-
    get_pfs_pf(PFId_Atom,
               Order_Int,
               Number_Int,
               ParentSuccessorStatementId_Atom),
    get_pfs_successor_statement(ParentSuccessorStatementId_Atom,
                                PFTraceSuccessorStatement,
                                ParentStatementId_Atom),
    get_pfs_statement(ParentStatementId_Atom, PFTraceStatement),
    maybe_echo_pf_trace_statement(SimplifiedVcgFile_Stream, ParentStatementId_Atom, PFTraceStatement),
    maybe_echo_pf_trace_successor_statement(SimplifiedVcgFile_Stream, ParentSuccessorStatementId_Atom, PFTraceSuccessorStatement),
    do_echo_path(SimplifiedVcgFile_Stream, Number_Int),
    !.

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






maybe_echo_pf_trace_statement(_SimplifiedVcgFile_Stream, ParentStatementId_Atom, _PFTraceStatement):-
    have_seen(ParentStatementId_Atom),
    !.

maybe_echo_pf_trace_statement(SimplifiedVcgFile_Stream, ParentStatementId_Atom, PFTraceStatement):-
    maybe_echo_pf_trace_statement_x(PFTraceStatement, AtomListList),
    flatten_list(AtomListList, AtomList),
    implode_separator_content_list('', AtomList, Atom),
    consider_fudge_line(SimplifiedVcgFile_Stream),
    assert(pfs_format(extraline)),
    write(SimplifiedVcgFile_Stream, Atom),nl(SimplifiedVcgFile_Stream),
    assert(stmt_line(Atom)),
    assert(have_seen(ParentStatementId_Atom)),
    !.

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

consider_fudge_line(SimplifiedVcgFile_Stream):-
    pfs_format(extraline),
    nl(SimplifiedVcgFile_Stream),
    !.

consider_fudge_line(_SimplifiedVcgFile_Stream):-
    !.

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

maybe_echo_pf_trace_statement_x(statement(PFPositionFrom, Successors_Int),
                                ['Statement: ',OutPFPositionFrom,OutSuccessors]):-
    maybe_echo_pf_trace_statement_pfpositionfrom(PFPositionFrom, OutPFPositionFrom),
    maybe_echo_pf_trace_statement_pfsuccessors_int(Successors_Int, OutSuccessors),
    !.

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

maybe_echo_pf_trace_statement_pfpositionfrom(start, ['start ']):-
    !.

maybe_echo_pf_trace_statement_pfpositionfrom(line(Int), ['line ', IntAtom]):-
    integer_to_atom(Int, IntAtom),
    !.

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

maybe_echo_pf_trace_statement_pfsuccessors_int(Int, ['     ', IntAtom,' successor(s)']):-
    integer_to_atom(Int, IntAtom),
    !.

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

maybe_echo_pf_trace_successor_statement(_SimplifiedVcgFile_Stream, ParentStatementId_Atom, _PFTraceStatement):-
    have_seen(ParentStatementId_Atom),
    !.

maybe_echo_pf_trace_successor_statement(SimplifiedVcgFile_Stream, ParentSuccessorStatementId_Atom, PFTraceSuccessorStatement):-
    maybe_echo_pf_trace_successor_statement_x(PFTraceSuccessorStatement, AtomListList),
    flatten_list(AtomListList, AtomList),
    implode_separator_content_list('', AtomList, Atom),
    write(SimplifiedVcgFile_Stream, Atom),nl(SimplifiedVcgFile_Stream),
    assert(succ_line(Atom)),
    assert(have_seen(ParentSuccessorStatementId_Atom)),
    !.

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

maybe_echo_pf_trace_successor_statement_x(successor_statement(PFPositionTo),
                                          ['  Successor statement: ',
                                           PFPositionToOut, '.']):-
    maybe_echo_pf_trace_pfpositionto(PFPositionTo,
                                     PFPositionToOut),
    !.

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

maybe_echo_pf_trace_pfpositionto(finish,
                                 [' finish']):-
    !.

maybe_echo_pf_trace_pfpositionto(line(Int), ['line ', IntAtom]):-
    integer_to_atom(Int, IntAtom),
    !.

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

do_echo_path(SimplifiedVcgFile_Stream, Int):-
    Int < 10,
    integer_to_atom(Int, IntAtom),
    implode_separator_content_list('', ['    Path  ', IntAtom], Atom),
    write(SimplifiedVcgFile_Stream, Atom),nl(SimplifiedVcgFile_Stream),
    assert(path_line(Atom)),
    !.

% Only one space separator if at 10 or more.
do_echo_path(SimplifiedVcgFile_Stream, Int):-
    integer_to_atom(Int, IntAtom),
    implode_separator_content_list('', ['    Path ', IntAtom], Atom),
    write(SimplifiedVcgFile_Stream, Atom),nl(SimplifiedVcgFile_Stream),
    assert(path_line(Atom)),
    !.

%===============================================================================
% refactor_write_vcs(+SimplifiedVcgFile_Stream, +Order_Int, +Id_Atom).
%===============================================================================
% Display the content part of verification conditions, dead path search
% or path function.
%===============================================================================

% Keep vc/path functions separate.
refactor_write_vcs(SimplifiedVcgFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(verification_conditions),
    setup_vc_name(Order_Int, Id_Atom),
    perform_write_verification_conditions(SimplifiedVcgFile_Stream, Id_Atom),
    !.

refactor_write_vcs(SummaryDpcFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(deadpath_search),
    setup_vc_name(Order_Int, Id_Atom),
    perform_write_verification_conditions(SummaryDpcFile_Stream, Id_Atom),
    !.

refactor_write_vcs(SimplifiedVcgFile_Stream, Order_Int, Id_Atom):-
    get_provenance_proof_file_kind(path_functions),
    perform_write_path_functions(SimplifiedVcgFile_Stream, Order_Int, Id_Atom),
    !.

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

perform_write_verification_conditions(SimplifiedVcgFile_Stream, Id_Atom):-
    write_vc(SimplifiedVcgFile_Stream, Id_Atom),
    write_log_facts,
    !.

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

perform_write_path_functions(SimplifiedVcgFile_Stream, _Order_Int, PFId_Atom):-
    write_vc(SimplifiedVcgFile_Stream, PFId_Atom), flush_output,
    write_log_facts,
    !.

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

setup_vc_name(Order_Int, Id_Atom):-
    retractall(vc_name(_)),
    get_vcg_vc(Id_Atom, Order_Int, Name_Atom, _Number_Int, _ParentVCTraceId_Atom),
    atom_concat(Name_Atom, '.', UseName_Atom),
    assert(vc_name(UseName_Atom)),
    !.

%===============================================================================
% tidy_up_vc_state.
%===============================================================================
% Clear up the vc state.
%===============================================================================

tidy_up_vc_state :-
        prune_all_hyps(_,_,_),
        reset_next_hyp_id,
        prune_all_concs(_, _, _),
        retractall(found_contradiction),
        retractall(allow_new_strategies),
        retractall(join_hyp(_,_,_,_)),
        prune_all_subst_hyp(_, _, _),
        retractall(could_infer(_,_)),
        retractall(could_not_infer(_)),
        retractall(used(_)),
        retractall(inference_depth_limit(_,_)),
        retractall(raw_hyp_already_read(_,_)),
        !.

%===============================================================================
% report_to_user.
%===============================================================================
% Report progress to user.
%===============================================================================

% Switch for dead path is off.

report_to_user(_VC_Id) :-
    get_switch_deadpaths(off),
    get_switch_verbose(on),
    !,
    (
      proved_all_conclusions,
      issue_message('All conclusions proved', [])
    ;
      found_contradiction,
      issue_message(' - Proved by contradiction within hypotheses', [])
    ;
      max_written_conc_no(MCN),
      issue_message('Number of conclusions remain unproven: ', MCN)
    ), 
    issue_message('\n', []),
    !.

report_to_user(VC_Id) :-
    % Report search for dead paths by ZombieScope.
    get_switch_deadpaths(on),
    !,
    report_to_user_deadpaths(VC_Id).

% DELETE_PATH_FUNCTIONS

report_to_user(_VC_Id) :-
        path_functions,
        /* output will be suppressed if echo is off. Churn out current path number instead */
        !,
        current_vc_number(N),
        telling(OLDF),
        tell(user),
        write('Simplified path function: '),
        write(N),
        nl,
        flush_output, /*** Flush so that SPARKSimp gets the output promptly ***/

        tell(OLDF).

% END_DELETE_PATH_FUNCTIONS

report_to_user(_VC_Id) :-
        /* output will be suppressed if echo is off. Churn out current vc number instead */
        !,
        current_vc_number(N),
        telling(OLDF),
        tell(user),
        write('Simplified VC: '),
        write(N),
        (
          proved_all_conclusions,
          write(' - All conclusions proved')
        ;
          found_contradiction,
          write(' - Proved by contradiction within hypotheses')
          ;
          max_written_conc_no(MCN),
          write(' - '),
          (
            MCN == 1,
            write('1 conclusion remains unproven')
          ;
            write(MCN),
            write(' conclusions remain unproven')
          ),
          retractall(max_written_conc_no(_))
        ),
        nl,
        flush_output, /*** Flush so that SPARKSimp gets the output promptly ***/
        tell(OLDF).

% Found dead path.
report_to_user_deadpaths(VC_Id) :-
    current_vc_number(N),
    telling(OLDF),
    tell(user),
    write('VC: '),
    write(N),
    report_to_user_deadpaths_x(VC_Id),
    tell(OLDF),
    !.

% ZombieScope detects a dead path if it proves the conclusion "false" by
% inference or by contradiction.

report_to_user_deadpaths_x(_VC_Id) :-
    proved_all_conclusions,
    !,
    write_deadpath_message.

report_to_user_deadpaths_x(_VC_Id) :-
    found_contradiction,
    !,
    write_deadpath_message.

% Not a dead path.
report_to_user_deadpaths_x(VC_Id) :-
    \+ get_zombiescope_no_check_required(VC_Id),
    !,
    write(' - No dead path detected \n'),
    !.

report_to_user_deadpaths_x(_VC_Id) :-
    % get_zombiescope_no_check_required(N),
    write(' - DPC not required for intermediate check\n'),
    !.

% Write dead path detected message.
write_deadpath_message :-
    write(' - Dead path detected \n').


% clauses used for reporting errors in a particular VC hyp or conc
write_identity_of_predicate(N, VC_Num, hyp) :-
	write('VC '), write(VC_Num), write(' H'), write(N).

write_identity_of_predicate(N, VC_Num, conc) :-
	write('VC '), write(VC_Num), write(' C'), write(N).


/*** note use print/1 here to get FDL layout ***/
write_offending_predicate(FORMULA) :-
	write('Offending predicate is: '), print(FORMULA), nl.


%===============================================================================
% process_component(+Term, +Number_Int, +VC_Num, +HypOrConc).
%===============================================================================
% Adds Term as number Number_Int as a hypothesis or conclusion, depending
% on HypOrConc. VC_Num is the current VC number, which is used in reporting
% errors.
%===============================================================================

process_component(FORM, N, VC_Num, Any) :-    /* Trap formulae with Prolog variables in first */
        \+ novars(FORM),
        !,
        write_error_preamble,
        write_identity_of_predicate(N, VC_Num, Any),
        write(' - Prolog variables occur in predicate.'),
        nl,
        /* we don't write the offending predicate out here, since the PROLOG     */
        /* variables get reported as _XXXXX where XXXXX varies between platforms */
        /* This causes spurious regression test failures.                        */
        set_exit_status,
        close_all_streams,
        halt,
        !.

process_component(true, N, _VC_Num, hyp) :-      /* Ignore true-already hypotheses */
        add_hyp_with_id(true, x, N),
        !.

process_component(FORM, N, _VC_Num, hyp) :-      /* Next look for hypotheses already read in */
        raw_hyp_already_read(M, FORM),
        !,
        assert_log_fact(repeat_hyp, [N, M]),
        add_hyp_with_id(true, x, N),
        !.

process_component(FORM, N, VC_Num, F) :-        /* Otherwise, process normally */
        (
           F = conc
        ;
           assertz(raw_hyp_already_read(N, FORM))
        ),
        process_formula(FORM, FORMULA, N, VC_Num, F),
        process_component_x(F, FORMULA, x, N),
        log_simplification(F, N, FORM, FORMULA),
        !.

process_component_x(hyp, FORMULA, Type, Id):-
    add_hyp_with_id(FORMULA, Type, Id),
    !.

process_component_x(conc, FORMULA, Type, Id):-
    add_conc_with_id(FORMULA, Type, Id),
    !.

process_component_x(HorC, _FORMULA, _Type, _Id):-
    show_error('HorC is not hyp or conc in predicate process_component_x but is: ~a', [HorC]),
    !.


/*** process_formula(OLD,NEW,N,VC_Num,F) -- filter & simplify OLD to get NEW ***/
/*** VC_Num, N, and F are used to report errors                              ***/
process_formula(OLD_FORMULA, NEW_FORMULA, N, VC_Num, F) :-
        (
           restructure_formula(OLD_FORMULA, INTERMEDIATE)
        ;
           write_error_preamble,
           write_identity_of_predicate(N, VC_Num, F),
           write(' - Restructuring failed.'),
           nl,
           write_offending_predicate(OLD_FORMULA),
           set_exit_status,
           close_all_streams,
           halt
        ),
        !,
        (
           typechecking_during_load(on),
           (
              checktype(INTERMEDIATE, boolean)
           ;
              write_error_preamble,
              write_identity_of_predicate(N, VC_Num, F),
              write(' did not typecheck as boolean.'),
              nl,
              write_offending_predicate(OLD_FORMULA),
              !,
              set_exit_status,
              close_all_streams,
              halt
           )
        ;
           true
        ),
        !,
        (
           simplification_is_on,
           (
              simplify(INTERMEDIATE, NEW_FORMULA)
           ;
              nl,
              write('!!! WARNING: '),
              write_identity_of_predicate(N, VC_Num, F),
              write(' - Simplification failed.'),
              nl,
              write_offending_predicate(OLD_FORMULA),
              NEW_FORMULA=INTERMEDIATE
           )
        ;
           NEW_FORMULA=INTERMEDIATE
        ),
        !.

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

/*** restructure_formula(OLD,NEW) -- no ~, set & seq prefix changes ***/
restructure_formula(for_all(V:T, P), for_all(V:CT, NewP)) :-
        find_core_type(T, CT),
        (
           % Required quantified variable already exists.
           % The variable is reused.
           var_const(V, CT, _),
           !,
           restructure_formula(P, NewP)
        ;
           % Required quantified variable does not already exist. It is
           % introduced, to support restructuring, and removed afterwards.
           asserta(var_const(V, CT, temp)),
           (
              restructure_formula(P, NewP),
              retract(var_const(V, CT, temp))
           ;
              retract(var_const(V, CT, temp)),
              !,
              fail
           )
        ),
        !.

restructure_formula(for_some(V:T, P), for_some(V:CT, NewP)) :-
        find_core_type(T, CT),
        (
           % Required quantified variable already exists.
           % The variable is reused.
           var_const(V, CT, _),
           !,
           restructure_formula(P, NewP)
        ;
           % Required quantified variable does not already exist. It is
           % introduced, to support restructuring, and removed afterwards.
           asserta(var_const(V, CT, temp)),
           (
              restructure_formula(P, NewP),
              retract(var_const(V, CT, temp))
           ;
              retract(var_const(V, CT, temp)),
              !,
              fail
           )
        ),
        !.

restructure_formula(X+Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWX \/ NEWY)
        ;
           restructure_nonset(X, NEWX),
           NEW = NEWX + NEWY
        ), !.

restructure_formula(X*Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWX /\ NEWY)
        ;
           restructure_nonset(X, NEWX),
           NEW = NEWX * NEWY
        ), !.

restructure_formula(X-Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWX \ NEWY)
        ;
           restructure_nonset(X, NEWX),
           NEW = NEWX - NEWY
        ), !.

restructure_formula(X/Y, NEW) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !,


        checktype(NEWX, TX),
        checktype(NEWY, TY),
        !,
        (
           TX = integer,
           TY = integer,
           NEW iss (NEWX div NEWY),                             /*1.4*/ /* SEPR 627 */
           int(NEW),            /* for safety: don't want to invoke =:= evaluation  */
           int(NEWX),           /* unless we're certain both sides can be evaluated */
           int(NEWY),           /* to an integer.                                   */
           NEWX =:= NEW * NEWY  /* only if Y divides X */       /*1.4*/
        ;
           NEW = (NEWX / NEWY)
        ),
        !.

restructure_formula(X rem Y, NEWX rem NEWY) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula(X<=Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_formula(X, NEWX),
           NEW = (NEWX subset_of NEWY)
        ;
           restructure_formula(X, NEWX),
           NEW = (NEWX <= NEWY)
        ), !.

restructure_formula(X>=Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWY subset_of NEWX)
        ;
           restructure_nonset(X, NEWX),
           NEW = (NEWX >= NEWY)
        ), !.

restructure_formula(X<Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWX strict_subset_of NEWY)
        ;
           restructure_nonset(X, NEWX),
           NEW = (NEWX < NEWY)
        ), !.

restructure_formula(X>Y, NEW) :-
        restructure_formula(Y, NEWY),
        !,
        (
           checktype(NEWY, T),
           type(T, set(_)),
           restructure_set(X, NEWX),
           NEW = (NEWY strict_subset_of NEWX)
        ;
           restructure_nonset(X, NEWX),
           NEW = (NEWX > NEWY)
        ), !.

restructure_formula(element(A, I), element(NEWA, NEWI)) :-
        restructure_formula(A, NEWA),
        !,
        restructure_formula_list(I, NEWI),
        !.

restructure_formula(update(A, I, X), update(NEWA, NEWI, NEWX)) :-
        restructure_formula(A, NEWA),
        !,
        restructure_formula_list(I, NEWI),
        !,
        restructure_formula(X, NEWX),
        !.

restructure_formula(first(X), first(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(last(X), last(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(nonfirst(X), nonfirst(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(nonlast(X), nonlast(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(X @ Y, NEWX @ NEWY) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula(X xor Y, (NEWX or NEWY) and not (NEWX and NEWY)) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula(X or Y, NEWX or NEWY) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula(X and Y, NEWX and NEWY) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula(not X, not NEWX) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(succ(X), succ(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(pred(X), pred(NEWX)) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(-X, -NEWX) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(+X, NEWX) :-
        restructure_formula(X, NEWX),
        !.

restructure_formula(abs(X), abs(NEWX)) :-
        restructure_nonset(X, NEWX),
        !.

restructure_formula(sqr(X), sqr(NEWX)) :-
        restructure_nonset(X, NEWX),
        !.

restructure_formula(odd(X), odd(NEWX)) :-
        restructure_nonset(X, NEWX),
        !.

restructure_formula(X ** Y, NEWX ** NEWY) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.

restructure_formula((X~), NV) :-
        twiddles_conversion(X, NV), !.

restructure_formula((X~), NV) :-
        path_functions,         /* in which case it's an X' */
        !,
        atom(X),
        name(X,XL),
        append(XL,[39],NVL),    /* N.B. [39] = "'" */
        name(NV,NVL),
        var_const(X,TYPE,v),
        assertz(var_const(NV,TYPE,c)),
        save_used_identifier(NV, var_const),
        assertz(twiddles_conversion(X, NV)),
        !.

restructure_formula((X~), NV) :-
        atom(X),
        name(X,XL),
        append(XL,"~",NVL),
        name(NV,NVL),
        var_const(X,TYPE,v),
        assertz(var_const(NV,TYPE,c)),
        save_used_identifier(NV, var_const),
        assertz(twiddles_conversion(X, NV)),
        !.

restructure_formula(+X, Y) :- restructure_formula(X, Y), !.
restructure_formula(X, X) :- atomic(X), !.
restructure_formula(X, X) :- float(X), !.
restructure_formula(X, NEWX) :-
        nonvar(X),
        X =.. [F|ARGS],
        get_provenance_framework(spark),
        (
           F = mk__array,
           !,
           restructure_array_aggregate(ARGS, NEWARGS)
        ;
           F = mk__record,
           !,
           restructure_record_aggregate(ARGS, NEWARGS)
        ;
           mk__function_name(F, _, array),
           !,
           restructure_array_aggregate(ARGS, NEWARGS)
        ;
           mk__function_name(F, _, record),
           !,
           restructure_record_aggregate(ARGS, NEWARGS)
        ),
        !,
        NEWX =.. [F|NEWARGS].

restructure_formula(X, Y) :-
        function_template(X, XL, F),
        !,
        restructure_formula_list(XL, YL),
        function_template(Y, YL, F),
        !.

restructure_formula(X, Y) :-
        record_function(K, X, _, F, XL, _),
        !,
        restructure_formula_list(XL, YL),
        record_function(K, Y, _, F, YL, _),
        !.

restructure_formula(X, Y) :-
        nonvar(X),
        X=..[OP|XARGS],
        (
           type(OP,set(_)),
           XARGS=[XL],
           restructure_formula_list(XL, YL),
           Y=(set YL)
        ;
           type(OP,sequence(_)),
           XARGS=[XL],
           restructure_formula_list(XL, Y)
        ;
           XARGS = [XARG],
           (
              (
                 OP = 'INTEGER'
              ;
                 OP = 'SHORT_INTEGER'
              ;
                 OP = 'LONG_INTEGER'
              ),
              TYPE = integer
           ;
              TYPE = OP
           ),
           restructure_formula(XARG, YARG),
           !,
           (
              checktype(YARG, TYPE),
              Y = YARG
           ;
              Y =.. [OP,YARG]
           )
        ;
           name(OP, OPL),
           append("mk__", TL, OPL),
           name(TYP, TL),
           (
              type(TYP, array(_,_)),
              AF = mk__array
           ;
              type(TYP, record(_)),
              AF = mk__record
           ),
           X1 =.. [AF|XARGS],
           !,
           restructure_formula(X1, Y)
        ;
           restructure_formula_list(XARGS, YARGS),
           Y=..[OP|YARGS]
        ), !.

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

restructure_formula_list([X], [Y]) :-
        restructure_formula(X, Y),
        !.

restructure_formula_list([X|XL], [Y|YL]) :-
        restructure_formula(X, Y),
        !,
        restructure_formula_list(XL, YL),
        !.

restructure_formula_list([], []) :- !.

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

/*** restructure_set(OLD,NEW) -- no ~, set & seq prefix changes ***/
restructure_set(X+Y, NEWX \/ NEWY) :-
        restructure_set(X, NEWX),
        restructure_set(Y, NEWY),
        !.

restructure_set(X*Y, NEWX /\ NEWY) :-
        restructure_set(X, NEWX),
        restructure_set(Y, NEWY),
        !.

restructure_set(X-Y, NEWX \ NEWY) :-
        restructure_set(X, NEWX),
        restructure_set(Y, NEWY),
        !.

restructure_set(X, Y) :- !, restructure_formula(X, Y), !.

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

/*** restructure_nonset(OLD,NEW) -- no ~, set & seq prefix changes ***/
restructure_nonset(X+Y, NEWX+NEWY) :-
        restructure_nonset(X, NEWX),
        restructure_nonset(Y, NEWY),
        !.

restructure_nonset(X*Y, NEWX*NEWY) :-
        restructure_nonset(X, NEWX),
        restructure_nonset(Y, NEWY),
        !.

restructure_nonset(X-Y, NEWX-NEWY) :-
        restructure_nonset(X, NEWX),
        restructure_nonset(Y, NEWY),
        !.

restructure_nonset(X, Y) :- !, restructure_formula(X, Y), !.

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

restructure_array_aggregate([X|XL], [Y|YL]) :-
        (
           X = (IND := EXPR),
           !,
           restructure_formula(EXPR, NEWEXPR),
           !,
           (
              IND = (IND1 & IND2),
              restructure_indices(IND1, NEWIND1),
              restructure_indices(IND2, NEWIND2),
              !,
              NEWIND = (NEWIND1 & NEWIND2)
           ;
              IND = [LO .. HI],
              restructure_formula(LO, NEWLO),
              restructure_formula(HI, NEWHI),
              !,
              NEWIND = [NEWLO .. NEWHI]
           ;
              IND = [I],
              restructure_formula(I, NEWI),
              !,
              NEWIND = [NEWI]
           ),
           !,
           Y = (NEWIND := NEWEXPR)
        ;
           restructure_formula(X, Y)
        ),
        !,
        restructure_array_aggregate(XL, YL),
        !.

restructure_array_aggregate([], []) :- !.

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

restructure_indices(X & Y, NEWX & NEWY) :-
        restructure_indices(X, NEWX),
        restructure_indices(Y, NEWY),
        !.
restructure_indices([X .. Y], [NEWX .. NEWY]) :-
        restructure_formula(X, NEWX),
        restructure_formula(Y, NEWY),
        !.
restructure_indices([I], NEWIND) :-
        restructure_formula(I, NEWI),
        !,
        NEWIND = [NEWI],
        !.

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

restructure_record_aggregate([F := EXP | REST], [F := NEWEXP | NEWREST]) :-
        !,
        restructure_formula(EXP, NEWEXP),
        !,
        restructure_record_aggregate(REST, NEWREST),
        !.
restructure_record_aggregate([], []) :- !.

%===============================================================================
% log_simplification(+HorC, +N, +OLD, +NEW).
%===============================================================================

log_simplification(_HorC, _N, OLD, OLD) :- !.

log_simplification(HorC, N, OLD, NEW) :-
        assert_log_fact(simplified, [HorC, N, OLD, NEW]),
        !.

%===============================================================================
% do_wrap_lines.
%-------------------------------------------------------------------------------
% Wrap lines in logfile.
%===============================================================================

do_wrap_lines :-
        nowrap_output_files,
        !.
do_wrap_lines :-
    retrieve_simplified_proof_file(File_Atom),
    name(File_Atom, NEWVCL1),
    !,
    NEWVCL2 = NEWVCL1,
    !,
    do_wrap_lines_of(NEWVCL1, NEWVCL2),
    !,
        (
         no_log_file
         ;
         logfile_name(LOGFILE),
         name(LOGFILE, LOGFL),
         do_wrap_lines_of(LOGFL, LOGFL)
         ),
    !.


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