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


/*** write_log - write proof log output for this step ***/
write_log :-
        \+ logfact(_, _),
        !.
write_log :-
        logfile_name(LOGNAME),
        step_number(STEP),
        fetch_indentation(SPC),
        file_can_be_written(LOGNAME),
        tell(LOGNAME),
        nl,
        process_logfact(SPC, step, STEP),
        nl,
        retract(logfact(TYPE, OBJECT)),
        fetch_indentation(SPACES),
        process_logfact(SPACES, TYPE, OBJECT),
        nl,
        fail.
write_log :-
        logfile_name(LOGNAME),
        \+ file_can_be_written(LOGNAME),
        write('Aborted: '),
        print(LOGNAME),
        write(' cannot be written.'),
        nl,
        !,
        close_all_streams,
        halt.
write_log :-
        tell(user),
        !.


fetch_indentation(INDENTATION) :-
        indentation(INDENTATION),
        !.


process_logfact(SPACES, step, STEP) :-
        (
           (
           \+ logfact(exit, [])
           ;
           \+ logfact(forceexit, [])
           ),
           tab(SPACES),
           write('STEP '),
           print(STEP)
        ;
           true
        ), !.
process_logfact(SPACES, text, TEXT) :-
        tab(SPACES),
        prooflog_width(W),
        (
           W=0,
           print(TEXT)
        ;
           WIDTH is W-SPACES,
           pretty_write(TEXT,WIDTH,_)
        ),
        !.
process_logfact(SPACES, command, COMMAND) :-
        tab(SPACES),
        write('Command: '),
        print(COMMAND),
        !.
process_logfact(SPACES, method, [(cases), h#N]) :-
        tab(SPACES),
        write('Commence PROOF BY CASES attempt on H'),
        print(N),
        !.
process_logfact(SPACES, method, METHOD) :-
        tab(SPACES),
        write('Commence PROOF BY '),
        print(METHOD),
        write(' attempt'),
        !.
process_logfact(SPACES, newhyp, hyp(N,F)) :-
        tab(SPACES),
        write('*** New H'),
        prooflog_width(W),
        (
           W=0,
           print(N),
           write(': '),
           print(F)
        ;
           WIDTH is W-SPACES-9,
           pretty_write(N, WIDTH, W1),
           pretty_write(': ', W1, W2),
           pretty_write(F, W2, _)
        ),
        !.
process_logfact(SPACES, newconc, conc(N,F)) :-
        tab(SPACES),
        write('>>> New goal C'),
        prooflog_width(W),
        (
           W=0,
           print(N),
           write(': '),
           print(F)
        ;
           WIDTH is W-SPACES-14,
           pretty_write(N, WIDTH, W1),
           pretty_write(': ', W1, W2),
           pretty_write(F, W2, _)
        ),
        !.
process_logfact(SPACES, vcname, VCNAME) :-
        tab(SPACES),
        write('Now attempting proof of VC: '),
        print(VCNAME),
        retractall(ruleused(_)),
        nl,
        list,
        !.
process_logfact(SPACES, rulematch, ([FILE,NAME]: (F may_be_deduced_from G))) :-
        tab(SPACES),
        write('Successful inference with rule: '),
        print(NAME),
        nl,
        IN is SPACES+2,
        write_subgoal_list_proved(IN, G),
        tab(SPACES),
        write('Therefore '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-SPACES-10,
           pretty_write(F, WIDTH, _)
        ),
        save_ruleused([FILE,NAME]),
        !.
process_logfact(SPACES, rulematch, ([FILE,NAME]: (X may_be_replaced_by Y if G))) :-
        tab(SPACES),
        write('Successful substitution with rule: '),
        print(NAME),
        nl,
        IN is SPACES+2,
        write_subgoal_list_proved(IN, G),
        tab(SPACES),
        write('Allowing substitution of '),
        prooflog_width(W),
        (
           W=0,
           print(Y),
           nl,
           tab(SPACES),
           write('for '),
           print(X)
        ;
           WIDTH is W-SPACES-25,
           pretty_write(Y, WIDTH, _),
           nl,
           tab(SPACES),
           write('for '),
           WW is W-SPACES-4,
           pretty_write(X, WW, _)
        ),
        save_ruleused([FILE,NAME]),
        !.
process_logfact(0, proved, vc(NAME)) :-
        write('*** PROVED VC '),
        print(NAME),
        nl,
        nl,
        write_rules_used,
        nl,
        nl,
        nl,
        !.
process_logfact(SPACES, proved, all) :-
        tab(SPACES),
        write('*** Proved all conclusions'),
        nl,
        !.
process_logfact(SPACES, proved, conc(N,F)) :-
        tab(SPACES),
        write('*** Proved C'),
        prooflog_width(W),
        (
           W=0,
           print(N),
           write(': '),
           print(F)
        ;
           WIDTH is W-SPACES-12,
           pretty_write(N, WIDTH, W1),
           pretty_write(': ', W1, W2),
           pretty_write(F, W2, _)
        ),
        !.
process_logfact(SPACES, enterframe, NO) :-
        tab(SPACES),
        write('Entering new proof frame (DEPTH '),
        print(NO),
        write(') ...'),
        indentation(OLD_INDENT),
        retractall(indentation(_)),
        indentation_increment(INCREMENT),
        NEW_INDENT is OLD_INDENT+INCREMENT,
        asserta(indentation(NEW_INDENT)),
        !.
process_logfact(SPACES, exitframe, NO) :-
        tab(SPACES),
        write('Exiting current proof frame (DEPTH '),
        print(NO),
        write(')'),
        indentation(OLD_INDENT),
        retractall(indentation(_)),
        indentation_increment(INCREMENT),
        NEW_INDENT is OLD_INDENT-INCREMENT,
        asserta(indentation(NEW_INDENT)),
        !.
process_logfact(SPACES, quitframe, _NO) :-
        tab(SPACES),
        write('QUIT: give up attempt to prove subgoals of current proof frame'),
        indentation(OLD_INDENT),
        retractall(indentation(_)),
        indentation_increment(INCREMENT),
        NEW_INDENT is OLD_INDENT-INCREMENT,
        asserta(indentation(NEW_INDENT)),
        !.
process_logfact(SPACES, infer, FORMULA) :-
        tab(SPACES),
        write('Attempting to infer '),
        prooflog_width(W),
        (
           W=0,
           print(FORMULA)
        ;
           WIDTH is W-SPACES-20,
           pretty_write(FORMULA, WIDTH, _)
        ),
        !.
process_logfact(SPACES, subgoal, ([FILE,NAME]: (F may_be_deduced_from G))) :-
        tab(SPACES),
        write('Attempt to prove '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-SPACES-17,
           pretty_write(F, WIDTH, _)
        ),
        nl,
        tab(SPACES),
        write('by subgoaling on rule '),
        print(NAME),
        write('.'),
        nl,
        tab(SPACES),
        write('Unsatisfied subgoals are:'),
        nl,
        IN is SPACES+2,
        write_unproved_subgoals(IN, G),
        save_ruleused([FILE,NAME]),
        !.
process_logfact(SPACES, deduce, FORMULA) :-
        tab(SPACES),
        write('Proved: '),
        prooflog_width(W),
        (
           W=0,
           print(FORMULA)
        ;
           WIDTH is W-SPACES-8,
           pretty_write(FORMULA, WIDTH, _)
        ),
        nl,
        tab(SPACES),
        write('  by logical deduction'),
        !.
process_logfact(SPACES, standardisation, [OLD, NEW]) :-
        tab(SPACES),
        write('Use of standardisation'),
        nl,
        tab(SPACES),
        write('     on '),
        prooflog_width(W),
        (
           W=0,
           print(OLD)
        ;
           WIDTH is W-SPACES-8,
           pretty_write(OLD, WIDTH, _)
        ),
        nl,
        tab(SPACES),
        write('  gives '),
        (
           W=0,
           print(NEW)
        ;
           pretty_write(NEW, WIDTH, _)
        ),
        !.
process_logfact(SPACES, standardisation, hyp(N)) :-
        tab(SPACES),
        write('Apply standardiser on H'),
        print(N),
        !.
process_logfact(SPACES, standardisation, conc(N)) :-
        tab(SPACES),
        write('Apply standardiser on C'),
        print(N),
        !.
process_logfact(SPACES, cases, hyp(N)) :-
        tab(SPACES),
        write('Start proof-by-cases attempt on disjunction formula H'),
        print(N),
        !.
process_logfact(SPACES, (case), NO) :-
        tab(SPACES),
        write('Begin CASE '),
        print(NO),
        write(':'),
        !.
process_logfact(SPACES, induction, [FORMULA, VAR, BASE]) :-
        tab(SPACES),
        write('Attempt to prove '),
        prooflog_width(W),
        (
           W=0,
           print(FORMULA)
        ;
           WIDTH is W-SPACES-17,
           pretty_write(FORMULA, WIDTH, _)
        ),
        nl,
        tab(SPACES),
        write('by induction on '),
        print(VAR),
        write(' (base case: '),
        print(VAR),
        write(' = '),
        print(BASE),
        write(')'),
        !.
process_logfact(SPACES, (consult), FILENAME) :-
        tab(SPACES),
        write('Consulted rulefile: '),
        print(FILENAME),
        !.
process_logfact(SPACES, library_name, FILENAME) :-
        tab(SPACES),
        write('Library rulefile: '),
        print(FILENAME),
        !.
process_logfact(SPACES, lib_fault, [IDENT, STRUCT]) :-
        tab(SPACES),
        write('LIBRARY REJECTED: mismatch between .FDL declarations and library.'),
        nl, write('Involves identifier '), print(IDENT), write(' in: '),
        print(STRUCT), write('.'),
        !.
process_logfact(SPACES, lib_ok, []) :-
        tab(SPACES),
        write('LIBRARY LOADED: No FDL declaration mismatches found.'),
        !.
process_logfact(_, exit, _) :-
        write('*** END OF PROOF SESSION'),
        nl,
        nl,
        nl,
        write_summary_of_rules_used,
        nl,
        write_summary_of_proof_status,
        nl,
        !.
process_logfact(_, forceexit, _) :-
        write('*** END OF PROOF SESSION'),
        nl,
        nl,
        nl,
        write_summary_of_rules_used,
        nl,
        write_summary_of_proof_status,
        nl,
        !.
process_logfact(_, true_vc, VCNAME) :-                          /* CFR004 */
        write('*** True VC eliminated: '),                      /* CFR004 */
        print(VCNAME),                                          /* CFR004 */
        !.                                                      /* CFR004 */
process_logfact(SPACES, TYPE, OBJECT) :-
        tab(SPACES),
        write('!!! UNEXPECTED LOGFACT: logfact('),
        print(TYPE),
        write(', '),
        print(OBJECT),
        write(')'),
        !.


write_subgoal_list_proved(IN, [goal(G)]) :-
        tab(IN),
        write('Met constraint: '),
        /* G might have a variable in it, so renumber for consistency */
        mynumbervars(G, 1, _),
        prooflog_width(W),
        (
           W=0,
           print(G)
        ;
           WIDTH is W-IN-16,
           pretty_write(G, WIDTH, _)
        ),
        nl,
        !.
write_subgoal_list_proved(IN, [F]) :-
        tab(IN),
        write('Proved subgoal: '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-IN-16,
           pretty_write(F, WIDTH, _)
        ),
        nl,
        !.
write_subgoal_list_proved(IN, [goal(G)|REST]) :-
        tab(IN),
        write('Met constraint: '),
        /* G might have a variable in it, so renumber for consistency */
        mynumbervars(G, 1, _),
        prooflog_width(W),
        (
           W=0,
           print(G)
        ;
           WIDTH is W-IN-16,
           pretty_write(G, WIDTH, _)
        ),
        nl,
        write_subgoal_list_proved(IN, REST),
        !.
write_subgoal_list_proved(IN, [F|REST]) :-
        tab(IN),
        write('Proved subgoal: '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-IN-16,
           pretty_write(F, WIDTH, _)
        ),
        nl,
        write_subgoal_list_proved(IN, REST),
        !.
write_subgoal_list_proved(IN, []) :-
        tab(IN),
        write('(unconstrained rule: no subgoals)'),
        nl,
        !.


write_unproved_subgoals(IN, [F]) :-
        tab(IN),
        write('Subgoal: '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-IN-9,
           pretty_write(F, WIDTH, _)
        ),
        nl,
        !.
write_unproved_subgoals(IN, [F|REST]) :-
        tab(IN),
        write('Subgoal: '),
        prooflog_width(W),
        (
           W=0,
           print(F)
        ;
           WIDTH is W-IN-9,
           pretty_write(F, WIDTH, _)
        ),
        nl,
        write_unproved_subgoals(IN, REST),
        !.
write_unproved_subgoals(IN, []) :-
        tab(IN),
        write('(no subgoals remaining (?!))'),
        nl,
        !.


/*** If F begins with the value of $SPADE_CHECKER then strip it off ***/
strip_rule_prefix(F, B) :-
        spade_checker_prefix(SCP),
        name(F, FCHARS),
        append(SCP, BASECHARS, FCHARS),
        name(B, BASECHARS),
        !.

/*** otherwise just leave it alone ***/
strip_rule_prefix(F, B) :-
        F = B,
        !.

print_rulename(N, R) :-
        plain_output(off),
        !,
        print(N),
        write('::'),
        print(R),
        nl.

print_rulename(N, R) :-
        plain_output(on),
        !,
        strip_rule_prefix(N, B),
        print(B),
        write('::'),
        print(R),
        nl.

write_rules_used :-
        sort_rules_used,
        fail.
write_rules_used :-
        \+ ruleused(_),
        write('The above proof did not make use of the proof rules database'),
        nl,
        !.
write_rules_used :-
        ruleused(X),
        \+ used_rule_other_than(X),
        maybe_add(ruleused_this_session(X)),
        write('The only rule used in proving the above VC was:'),
        nl,
        tab(10),
        retract(ruleused([N,R])),
        print_rulename(N, R),
        !.
write_rules_used :-
        write('The following rules were used in proving the above VC:'),
        nl,
        retract(ruleused([N,R])),
        maybe_add(ruleused_this_session([N,R])),
        tab(10),
        print_rulename(N, R),
        fail.
write_rules_used :- !.


used_rule_other_than(X) :-
        ruleused(Y),
        Y\=X,
        !.


write_summary_of_rules_used :-
        sort_rules_used_this_session,
        fail.
write_summary_of_rules_used :-
        \+ ruleused_this_session(_),
        write('The above proof session did not make use of the proof rules database'),
        nl,
        !.
write_summary_of_rules_used :-
        ruleused_this_session(X),
        \+ used_rule_this_session_other_than(X),
        write('The only rule used in the above proof session was:'),
        nl,
        tab(10),
        retract(ruleused_this_session([N,R])),
        print_rulename(N, R),
        !.
write_summary_of_rules_used :-
        write('The following rules were used during the above proof session:'),
        nl,
        retract(ruleused_this_session([N,R])),
        tab(10),
        print_rulename(N, R),
        fail.
write_summary_of_rules_used :- !.


used_rule_this_session_other_than(X) :-
        ruleused_this_session(Y),
        Y\=X,
        !.


save_ruleused(R) :-
        ruleused(R),
        !.
save_ruleused(R) :-
        assertz(ruleused(R)),
        !.


ruleused_noprefix([SN, FN, RN]) :-
        ruleused([FN, RN]),
        strip_rule_prefix(FN, SN).
                               

ruleused_this_session_noprefix([SN, FN, RN]) :-
        ruleused_this_session([FN, RN]),
        strip_rule_prefix(FN, SN).
                               

sort_rules_used :-
        /* Sort rules using the simple name (without the prefix) as primary key */
        findall(X, ruleused_noprefix(X), A),
        A \== [],
        sort(A, U),
        !,
        retractall(ruleused(_)),
        add_rules_again(ruleused,U),
        !.


sort_rules_used_this_session :-
        findall(X, ruleused_this_session_noprefix(X), B),
        B \== [],
        sort(B, U),
        !,
        retractall(ruleused_this_session(_)),
        add_rules_again(ruleused_this_session,U),
        !.


add_rules_again(_P,[]) :- !.
add_rules_again(P,[H|T]) :-
        H = [_SN, FN, RN],
        F =.. [P,[FN, RN]],
        assertz(F),
        !,
        add_rules_again(P,T),
        !.


write_summary_of_proof_status :-
        write_vcs_proved,
        nl,
        write_vcs_not_proved,
        !.


write_vcs_proved :-
        vcs_proved_this_session([]),
        !,
        write('No VCs were proved during this proof session.'),
        nl,
        !.
write_vcs_proved :-
        vcs_proved_this_session([[N]]),
        !,
        write('The only VC proved during this proof session was: '),
        print(N),
        nl,
        !.
write_vcs_proved :-
        vcs_proved_this_session(VCS),
        !,
        write('The following VCs were proved during this proof session:'),
        !,
        nl,
        tab(8),
        write_numbers_left(VCS),
        !.
write_vcs_proved :-
        \+ vcs_proved_this_session(_),
        !,
        write('No VCs were proved during this proof session.'),
        nl,
        !.


write_vcs_not_proved :-
        vcs_to_prove([]),
        !,
        write('There are no more VCs left to prove.'),
        !.
write_vcs_not_proved :-
        vcs_to_prove([[N]]),
        !,
        write('The only VC left to prove is: '),
        print(N),
        !.
write_vcs_not_proved :-
        vcs_to_prove(VCS),
        !,
        write('The following VCs have not yet been proved: '),
        nl,
        tab(8),
        write_numbers_left(VCS),
        !.
write_vcs_not_proved :-
        \+ vcs_to_prove(_),
        !,
        write('There are no more VCs left to prove.'),
        !.


/*** pretty_write(EXPRN, OLD_COLUMNS_LEFT, NEW_COLUMNS_LEFT) ***/

pretty_write(A, OC, NC) :-
        atomic(A),
        size(A,L),
        !,
        (
           L=<OC,
           print(A),
           NC is OC-L
        ;
           L>OC,
           nl,
           print(A),
           prooflog_width(LW),
           (
              L=<LW,
              NC is LW-L
           ;
              L>LW,
              NC=0
           )
        ), !.
pretty_write([X|Y],OC,NC) :-
        pretty_write('[',OC,NC1),
        !,
        pretty_write_arg_list([X|Y],NC1,NC2),
        !,
        pretty_write(']',NC2,NC),
        !.
pretty_write(A, OC, NC) :-
        \+(atomic(A)),
        nonvar(A),
        A=..[F|Args],
        !,
        (
           current_op(PREC,ASSOC,F),
           arg_nums_compatible(ASSOC,Args),
           (
              Args=[AA],
              (
                 AA=..[G,A1],
                 B=[A1]
              ;
                 AA=..[G,A1,A2],
                 B=[A1,A2]
              ),
              current_op(Prec2,Assoc2,G),
              arg_nums_compatible(Assoc2,B),
              Prec2>=PREC,
              (
                 (
                    ASSOC=fx
                 ;
                    ASSOC=fy
                 ),
                 pretty_write(F,OC,NC1),
                 !,
                 pretty_write(' (',NC1,NC2),
                 !,
                 pretty_write(AA,NC2,NC3),
                 !,
                 pretty_write(')',NC3,NC)
              ;
                 (
                    ASSOC=xf
                 ;
                    ASSOC=yf
                 ),
                 pretty_write('(',OC,NC1),
                 !,
                 pretty_write(AA,NC1,NC2),
                 !,
                 pretty_write(') ',NC2,NC3),
                 !,
                 pretty_write(F,NC3,NC)
              )
           ;
              Args=[A1,A2],
              (
                 A1=..[G1|Args1],
                 current_op(Prec1,Assoc1,G1),
                 arg_nums_compatible(Assoc1,Args1),
                 Prec1>=PREC,
                 pretty_write('(',OC,NC1),
                 !,
                 pretty_write(A1,NC1,NC2),
                 !,
                 pretty_write(')',NC2,NC3)
              ;
                 pretty_write(A1,OC,NC3)
              ),
              !,
              pretty_write(' ',NC3,NC4),
              !,
              pretty_write(F,NC4,NC5),
              !,
              pretty_write(' ',NC5,NC6),
              (
                 A2=..[G2|Args2],
                 current_op(Prec2,Assoc2,G2),
                 arg_nums_compatible(Assoc2,Args2),
                 Prec2>=PREC,
                 pretty_write('(',NC6,NC7),
                 !,
                 pretty_write(A2,NC7,NC8),
                 !,
                 pretty_write(')',NC8,NC)
              ;
                 pretty_write(A2,NC6,NC)
              )
           )
        ;
           OC1 is OC-1,
           pretty_write(F,OC1,NC1),
           !,
           write('('),
           pretty_write_arg_list(Args, NC1, NC2),
           !,
           (
              NC2>0,
              write(')'),
              NC is NC2-1
           ;
              NC2=<0,
              nl,
              write(')'),
              prooflog_width(LW),
              NC is LW-1
           )
        ), !.


pretty_write_arg_list([A],OC,NC) :-
        !,
        pretty_write(A,OC,NC),
        !.
pretty_write_arg_list([A|AL],OC,NC) :-
        !,
        pretty_write(A,OC,NC1),
        !,
        pretty_write(', ',NC1,NC2),
        !,
        pretty_write_arg_list(AL,NC2,NC),
        !.


arg_nums_compatible(fx,[_]).
arg_nums_compatible(fy,[_]).
arg_nums_compatible(xf,[_]).
arg_nums_compatible(yf,[_]).
arg_nums_compatible(xfx,[_,_]).
arg_nums_compatible(xfy,[_,_]).
arg_nums_compatible(yfx,[_,_]).
arg_nums_compatible(yfy,[_,_]).

size(A,N) :-
        atom(A),
        name(A,L),
        !,
        length(L,N),
        !.
size(A,N) :-
        integer(A),
        (
           A>=0,
           S=0,
           B=A
        ;
           A<0,
           S=1,
           B is -A
        ),
        !,
        count_places(B,P),
        !,
        N is P+S.

count_places(I,1) :-
        I<10.
count_places(I,P) :-
        I>9,
        I1 iss I div 10,
        !,
        count_places(I1,P1),
        !,
        P is P1+1.
%###############################################################################
%END-OF-FILE
