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

save_state :-
        write('Saving'),
        csvfile_name(OUTFILE),
        file_can_be_written(OUTFILE),
        tell(OUTFILE),
        fetch_date_and_time(DATE, TIME),
        write('/* SAVED: '),
        print(DATE),
        write(', at '),
        print(TIME),
        write(' */'),
        nl,
        !,
        do_the_saving(OUTFILE).
save_state :-
        csvfile_name(OUTFILE),
        \+ file_can_be_written(OUTFILE),
        write('Warning: '),
        print(OUTFILE),
        write(' cannot be written.'),
        nl,
        !,
        close_all_streams,
        halt.


do_the_saving(OUTFILE) :-
        to_be_saved(PREDICATE),
        tell(user),
        write('.'),
        save_a_copy(OUTFILE, PREDICATE).
do_the_saving(OUTFILE) :-
        tell(OUTFILE),
        told,
        !.


save_a_copy(OUT, PRED) :-
        tell(OUT),
        call(PRED),
        distinguish_vars_in(PRED, 1, _),
        safe_write(PRED, 80, _),
        write('.'),
        nl,
        fail.


safe_write(A1, OC, NC) :-
        atom(A1),
        double_slash(A1, A),
        size(A, L),
        (
           L=<OC,
           put_code(39),
           print(A),
           put_code(39),
           NC is OC-L
        ;
           L>OC,
           nl,
           put_code(39),
           print(A),
           put_code(39),
           (
              L=<80,
              NC is 80-L
           ;
              L>80,
              NC=0
           )
        ), !.

safe_write(A, OC, NC) :-
        integer(A),
        size(A, L),
        (
           L=<OC,
           printq(A),
           NC is OC-L
        ;
           L>OC,
           nl,
           printq(A),
           (
              L=<80,
              NC is 80-L
           ;
              L>80,
              NC=0
           )
        ), !.

safe_write(A, OC, NC) :-
        var(A),
        !,
        write('_'),
        NC is OC+1,
        !.

safe_write([X|Y], OC, NC) :-
        write('['),
        safe_write_list([X|Y], OC, NC),
        write(']'),
        !.

safe_write('$$$'(N), OC, NC) :-
        write('A'),
        print(N),
        !,
        NCX is OC-3,
        (
           NCX > 0,
           NC = NCX
        ;
           nl,
           NC = 79
        ),
        !.

safe_write(A, OC, NC) :-
        \+(atomic(A)),
        nonvar(A),
        A =.. [F|ARGS],
        safe_write(F, OC, NC1),
        write('('),
        safe_write_list(ARGS, NC1, NC2),
        (
           NC2>0,
           write(')'),
           NC is NC2-1
        ;
           NC2=<0,
           nl,
           write(')'),
           NC=79
        ), !.


safe_write_list([A], OC, NC) :-
        safe_write(A, OC, NC),
        !.

safe_write_list([A|AL], OC, NC) :-
        safe_write(A, OC, NC1),
        write(', '),
        NC2 is NC1-2,
        safe_write_list(AL, NC2, NC),
        !.


distinguish_vars_in(VAR, N, N1) :-
        var(VAR),
        !,
        VAR = '$$$'(N),
        N1 is N+1,
        !.
distinguish_vars_in(ATOMIC, N, N) :-
        atomic(ATOMIC),
        !.
distinguish_vars_in(EXPRESSION, N, M) :-
        EXPRESSION =.. [_OP|ARGS],
        !,
        distinguish_vars_in_list(ARGS, N, M),
        !.


distinguish_vars_in_list([ARG], N, M) :-
        distinguish_vars_in(ARG, N, M),
        !.
distinguish_vars_in_list([EXPRESSION|ARGS], N, M) :-
        distinguish_vars_in(EXPRESSION, N, N1),
        !,
        distinguish_vars_in_list(ARGS, N1, M),
        !.
distinguish_vars_in_list([], N, N) :- !.

to_be_saved(auto_done(_)).
to_be_saved(auto_newvc(_)).                                     /* CFR1334 */
to_be_saved(banned_rule(_,_)).
to_be_saved(case(_,_,_)).
to_be_saved(case_pointer(_)).
to_be_saved(command_logging(_)).                                /* CFR1334 */
to_be_saved(conc(_,_)).
to_be_saved(csvfile_name(_)).
to_be_saved(current_root(_,_)).
to_be_saved(current_vc(_,_)).
to_be_saved(current_vc_no(_)).
to_be_saved(deleted(_)).
to_be_saved(deleted_hyp(_,_)).
to_be_saved(display_subgoals_max(_)).
to_be_saved(display_var_free_only(_)).
to_be_saved(echo(_)).
to_be_saved(enumeration(_,_)).
to_be_saved(fdl_file_title(_)).
to_be_saved(fdlfile_name(_)).
to_be_saved(forgotten(_)).
to_be_saved(function(_,_,_)).
to_be_saved(function_template(_,_,_)).
to_be_saved(hyp(_,_)).
to_be_saved(indentation(_)).
to_be_saved(indentation_increment(_)).
to_be_saved(inverse_video(_)).
to_be_saved(is_vc(_)).
to_be_saved(logfile_name(_)).
to_be_saved(mk__function_name(_,_,_)).                          /*1.4*/
to_be_saved(newline_after_prompts(_)).                          /* CFR1334 */
to_be_saved(normal_video(_)).
to_be_saved(on_case(_,_,_)).
to_be_saved(on_filename(_)).
to_be_saved(prooflog_width(_)).
to_be_saved(proved_for_case(_,_)).
to_be_saved(qvar(_)).
to_be_saved(record_consults(_)).                                /* CFR1334 */
to_be_saved(record_function(_,_,_,_,_,_)).                      /* CFR029 */
to_be_saved(ruleused(_)).
to_be_saved(ruleused_this_session(_)).
to_be_saved(saved_vc(_,_)).
to_be_saved(show_vc_changes(_)).                                /* CFR1334 */
to_be_saved(simplify_in_infer(_)).
to_be_saved(simplify_during_load(_)).
to_be_saved(spark_enabled).                                     /* CFR034 */
to_be_saved(step_number(_)).
to_be_saved(subgoal_formula(_,_,_,_)).
to_be_saved(type(_,_)).
to_be_saved(type_alias(_,_)).
to_be_saved(typechecking(_)).
to_be_saved(typechecking_during_load(_)).
to_be_saved(use_subst_rules_for_equality(_)).
to_be_saved(used_ident(_,_)).
to_be_saved(user_rulefile(_,_)).
to_be_saved(user_classification(_,_,_,_)).
to_be_saved(var_const(_,_,_)).
to_be_saved(vc(_,_)).
to_be_saved(vcgfile_name(_)).
to_be_saved(vcs_to_prove(_)).
to_be_saved(vc_name(_)).



/* The following predicates, double_slash and double_slash_list, are required
 * due to Poplog's Itemiser.  In short, on reading any two characters from an
 * input stream where the first character is "\", the Poplog itemiser
 * automatically interprets these two characters as a control characted.  For
 * example, "\t" gets interpreted as character 9 (IE, tab).  This means that
 * we never get to see a single "\" -- any input files need to say "\\".
 *
 * So, when writing the rulebase, we need to make sure that any single "\"
 * gets doubled-up, so that when the Checker reads in the RLB, it sees correct
 * paths. */
double_slash(A,A1) :-
   atom(A),
   !,
   name(A, ALIST),
   double_slash_list(ALIST, ALIST2),
   name(A1, ALIST2),
   !.

double_slash_list([], []).

double_slash_list([92|ALIST], [92,92|ALIST2]) :-
   double_slash_list(ALIST, ALIST2).

double_slash_list([X|ALIST], [X|ALIST2]) :-
   double_slash_list(ALIST, ALIST2).

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