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


/*** LOAD_VC -- load in a VC from the .VCG and .FDL files ***/
(load_vc) :-
        cmd_line_filename(FILENAME),
        (
           (
              done__resume,
              STATE = resume
           ;
              \+ done__resume,
              STATE = ordinary
           ),
           form_file_names(FILENAME, FL),
           load_vc(STATE),
           form_log_file_names(FL),                             /* CFR016 */
           create_backups,
           write_proof_log_banner
        ;
           write('Please try again.'), nl, fail
        ),
        !.
(load_vc) :-
    repeat,
        nl,
        write('Please type filename, without extension, in lowercase, within single'),
        nl,
        write('quotes if it is not in this directory, followed by a full-stop.'),
        nl,
        (
         % Resume may be specified on the command line.
         done__resume,
         write('Resume requested. FILENAME.csv will be read.')
        ;
         \+ done__resume,
         write('FILENAME.vcg and FILENAME.fdl will be read.')
        ),
        nl,
        prompt_user('Filename? '),
        read_term_and_layout(FILE),
        (
           atom(FILE),
           FILE = forceexit,
           close_all_streams,
           halt
        ;
           done__resume,
           atom(FILE),
           FILENAME=FILE,
           STATE=resume
        ;
           \+ done__resume,
           atom(FILE),
           FILENAME=FILE,
           STATE=ordinary
        ;
           write('Please try again.'),
           nl,
           fail
        ),
        form_file_names(FILENAME, FL),
        load_vc(STATE),
        form_log_file_names(FL),                                /* CFR016 */
        create_backups,
        write_proof_log_banner,
        !.


load_vc(ordinary) :-
    checkfilesexist(ordinary),
    nl,
    fdlfile_name(FDLFILE),
    vcgfile_name(VCGFILE),                                      /* CFR035 */
    scan_file_header_to_see_if_spark(VCGFILE),                  /* CFR035 */
    write('Reading '),
    print(FDLFILE),
    write(' (for inherited FDL type declarations)'),
    nl,
    load_decs(FDLFILE),
    (
       echo(off)
    ;
       nl,
       write('          ------------------------------------------------------------'),
       nl,
       nl
    ),
    write('Loading '),
    print(VCGFILE),
    write(' (verification conditions)'),
    nl,
    load_vcs(VCGFILE),
    !,
    asserta(do_do_newvc),
    !.

load_vc(resume) :-
        checkfilesexist(resume),
        csvfile_name(CSVFILE),
        nl,
        write('Consulting '),
        print(CSVFILE),
        write(' (checker saved proof state)'),

        % Supress all redefine warnings when loading the data file.
        set_prolog_flag(redefine_warnings, off),
        load_files(CSVFILE, [when(always), load_type(source), compilation_mode(assert_all)]),

        % Re-enable all redefine warnings.
        set_prolog_flag(redefine_warnings, on),
        !.


form_file_names(FILENAME, FL) :-
        retractall(fdlfile_name(_)),
        retractall(vcgfile_name(_)),
        retractall(csvfile_name(_)),
        !,
        name(FILENAME,FILENAMELIST),                            /* CFR022 */
        (                                                       /* CFR022 */
           gen_append(FL, ".siv", FILENAMELIST),                /* CFR022 */
           asserta(vcgfile_name(FILENAME))                      /* CFR022 */
        ;                                                       /* CFR022 */
           FL = FILENAMELIST,                                   /* CFR022 */
           append(FL,".vcg",INLIST),                            /* CFR022 */
           name(VCGFILE,INLIST),                                /* CFR022 */
           asserta(vcgfile_name(VCGFILE))                       /* CFR022 */
        ),                                                      /* CFR022 */
        !,                                                      /* CFR022 */
        append(FL,".fdl",FLIST),
        name(FDLNAME,FLIST),
        asserta(fdlfile_name(FDLNAME)),
        !,
        append(FL,".csv",CLIST),
        name(CSVFILE,CLIST),
        asserta(csvfile_name(CSVFILE)),
        !.                                                      /* CFR016 */


/* specifies file names for .cmd (both input and output) and .plg files */
form_log_file_names(FL) :-                                      /* CFR016 */
        retractall(logfile_name(_)),
        retractall(command_log_filename(_)),                    /* CFR016 */
        /* proof log */
        (
           /* if /proof_log is specified use that */
           cmd_line_proof_log(PROOFLOG),
           asserta(logfile_name(PROOFLOG))
        ;
           /* if no /proof_log specified, use filename.plg */
           append(FL,".plg",PLIST),
           name(PROOFLOG, PLIST),
           asserta(logfile_name(PROOFLOG))
        ),
        !,                                                      /* CFR016 */
        /* command log */
        (                                                       /* CFR016 */
           /* if /command_log is specified use that */
           cmd_line_command_log(CMDLOG),                        /* CFR016 */
           asserta(command_log_filename(CMDLOG)),               /* CFR016 */
           /* check that /command_log and script file have not been set to the same thing */
           (
              perform_script_file(CMDLOG),
              write('Aborted: Cannot set command_log and execute qualifiers to the same filename.'),
              nl,
              close_all_streams,
              halt
           ;
              true
           )
        ;                                                       /* CFR016 */

           /* if no /command_log specified, use filename.cmd */
           append(FL,".cmd",CLIST),                             /* CFR016 */
           name(CMDLOG, CLIST),                                 /* CFR016 */
           /* check that /command_log and script file have not been set to the same thing */
           (
              perform_script_file(CMDLOG),
              write('Aborted: Cannot have command_log and execute qualifiers as the same filename.'),
              nl,
              write('Consider renaming the execute log.'),
              nl,
              close_all_streams,
              halt
           ;
              true
           ),
           /* use filename.cmd as command log */
           asserta(command_log_filename(CMDLOG))                /* CFR016 */
        ),                                                      /* CFR016 */
        !.

/* Notify user that file does not have write permissions */
not_writeable_warning(EXISTINGFILE) :-
        tell(user),
        nl,
        write('!!! ERROR trying to delete '),
        printq(EXISTINGFILE),
        nl,
        nl,
        write('File is not writeable.'),
        close_all_streams,
        halt.

/* Notify user that file already exists, and ask for solution */
consult_user(FILENAME, EXISTINGFILE) :-
        tell(user),
        nl,
        write('!!! ERROR trying to move '),
        printq(FILENAME),
        write(' to '),
        printq(EXISTINGFILE),
        nl,
        nl,
        write('File already exists.'),
        !,
        nl,
        no_echo_read_answer('Do you want to delete this file?', ANSWER),
        (
           ANSWER = yes,
           (
              \+ file_can_be_written(EXISTINGFILE),
              not_writeable_warning(EXISTINGFILE)
           ;
              delete_file(EXISTINGFILE)
           )
        ;
           ANSWER = no,
           close_all_streams,
           halt
        ).


create_backups :-
        overwrite_warning(WARN),

        /* create backup .cmd file */
        command_log_filename(COMMANDLOG),
        (
           file_exists(COMMANDLOG),
           name(COMMANDLOG, CTEMP),
           append(CTEMP, "-", BACKUPCMD),
           name(CMD2, BACKUPCMD),
           (
               file_exists(CMD2),
               (
                   WARN = on,
                   consult_user(COMMANDLOG, CMD2)
               ;
                   WARN = off,
                   (
                      \+ file_can_be_written(CMD2),
                      not_writeable_warning(CMD2)
                   ;
                      delete_file(CMD2)
                   )
               )
           ;
               \+ file_exists(CMD2)
           ),
           rename_file(COMMANDLOG, CMD2)
        ;
           \+ file_exists(COMMANDLOG)
        ),
        /* create backup .plg file */
        logfile_name(PROOFLOG),
        (
           file_exists(PROOFLOG),
           name(PROOFLOG, PTEMP),
           append(PTEMP, "-", BACKUPPLG),
           name(PLG2, BACKUPPLG),
           (
               file_exists(PLG2),
               (
                   WARN = on,
                   consult_user(PROOFLOG, PLG2)
               ;
                   WARN = off,
                   (
                      \+ file_can_be_written(PLG2),
                      not_writeable_warning(PLG2)
                   ;
                      delete_file(PLG2)
                   )
               )
           ;
               \+ file_exists(PLG2)
           ),
           rename_file(PROOFLOG, PLG2)
        ;
           \+ file_exists(PROOFLOG)
        ).


checkfilesexist(ordinary) :-
        vcgfile_name(VCG),
        (
           file_exists_and_is_readable(VCG)
        ;
           tell_off(vcg)                                        /* CFR048 */
        ),
        !,
        fdlfile_name(FDL),
        (
           file_exists_and_is_readable(FDL)
        ;
           tell_off(fdl)                                        /* CFR048 */
        ),
        !.
checkfilesexist(resume) :-
        csvfile_name(CSV),
        (
           file_exists_and_is_readable(CSV)
        ;
           tell_off(csv)                                        /* CFR048 */
        ),
        !.


tell_off(TYPE) :-
        nl,
        write('No .'),
        print(TYPE),
        write(' file of this name exists.'),
        nl,
        nl,
        write('List of .'),
        print(TYPE),
        write(' files in current region:'),
        nl,
        list_files_with_extension(TYPE),
        fail.


/*** LOAD_DECS(FILENAME) -- load the declarations file ***/
load_decs(FILENAME) :-
    assertz(current_record_field_number(1)),
    see(FILENAME),
    repeat,
        get_fdl_declaration(DECLARATION),
        process_fdl_dec(DECLARATION),
    /* UNTIL */ final_declaration(DECLARATION),
    seen,
    !.


final_declaration([start|_]).
final_declaration([end|_]).                                     /* CFR037 */
final_declaration([W|_]) :- eof_char(EOF), name(W, [EOF]).


/*** IS_IN ***/
is_in(X,[X|_]) :- !.
is_in(X,[_|Y]) :- is_in(X,Y), !.


/*** GET_FDL_DECLARATION(TOKEN_LIST) ***/
get_fdl_declaration([WORD|REST]) :-
        eof_char(EOF),
        (
           retract(previous_character(CHAR))
        ;
           fget0(CHAR)
        ),
        !,
        (
           CHAR=EOF,
           WORD=end_of_file,
           REST=[]
        ;
           read_word(CHAR, WORD, NEXT_CHAR),
           read_rest(WORD, NEXT_CHAR, REST)
        ),
        !.


/*** READ_WORD(CHAR, WORD, NEXT_CHAR) ***/
read_word(CHAR, WORD, NEXT_CHAR) :-
        is_a_single_character(CHAR),
        !,
        name(WORD, [CHAR]),
        fget0(NEXT_CHAR),
        !.
read_word(CHAR, WORD, NEXT_CHAR) :-
        is_a_word_split_char(CHAR),
        fget0(NEW_CHAR),
        read_word(NEW_CHAR, WORD, NEXT_CHAR),
        !.
read_word(CHAR, WORD, NEXT_CHAR) :-
        make_lower_case(CHAR, CONVERTED_CHAR),
        fget0(NEW_CHAR),
        restword(NEW_CHAR, CHAR_LIST, NEXT_CHAR),
        truncate_list(24, [CONVERTED_CHAR|CHAR_LIST], CHOPPED_LIST),
        name(WORD, CHOPPED_LIST),
        !.


/*** RESTWORD(CHAR, CHAR_LIST, NEXT_CHAR) ***/
restword(CHAR, [], CHAR) :-
        is_a_word_split_char(CHAR),
        !.
restword(CHAR, [CONVERTED_CHAR|CHAR_LIST], NEXT_CHAR) :-
        make_lower_case(CHAR, CONVERTED_CHAR),
        fget0(NEW_CHAR),
        restword(NEW_CHAR, CHAR_LIST, NEXT_CHAR),
        !.


/*** IS_A_SINGLE_CHARACTER(CHAR) ***/
is_a_single_character(44).      /*  ,  */
is_a_single_character(58).      /*  :  */
is_a_single_character(59).      /*  ;  */
is_a_single_character(40).      /*  (  */
is_a_single_character(41).      /*  )  */
is_a_single_character(46).      /*  .  */
is_a_single_character(61).      /*  =  */
is_a_single_character(91).      /*  [  */
is_a_single_character(93).      /*  ]  */
is_a_single_character(EOF) :-
          eof_char(EOF).        /* EOF */


/*** IS_A_WORD_SPLIT_CHAR(CHAR) ***/
is_a_word_split_char(9).        /* TAB */
is_a_word_split_char(32).       /* ' ' */
is_a_word_split_char(46).       /*  .  */
is_a_word_split_char(44).       /*  ,  */
is_a_word_split_char(40).       /*  (  */
is_a_word_split_char(41).       /*  )  */
is_a_word_split_char(58).       /*  :  */
is_a_word_split_char(59).       /*  ;  */
is_a_word_split_char(61).       /*  =  */
is_a_word_split_char(91).       /*  [  */
is_a_word_split_char(93).       /*  ]  */
is_a_word_split_char(EOF) :-
          eof_char(EOF).        /* EOF */
is_a_word_split_char(EOL) :-
          eol_char(EOL).        /* EOL */


/*** LASTWORD(WORD) ***/
lastword(';').
lastword(start).
lastword(W) :- eof_char(EOF), name(W,EOF).


/*** MAKE_LOWER_CASE(CHAR, CONVERTED_CHAR) ***/
make_lower_case(CHAR, CONVERTED_CHAR) :-
        CHAR>64,
        CHAR<91,
        CONVERTED_CHAR is CHAR+32,
        !.
make_lower_case(CHAR, CHAR).


/*** READ_REST(WORD, NEXT_CHAR, REST) ***/
read_rest(WORD, CHAR, []) :-
        lastword(WORD),
        !,
        asserta(previous_character(CHAR)).
read_rest(_WORD, NEXT_CHAR, [NEXT_WORD|REST_OF_STMT]) :-
        read_word(NEXT_CHAR, NEXT_WORD, NEW_CHAR),
        read_rest(NEXT_WORD, NEW_CHAR, REST_OF_STMT),
        !.


/*** TRUNCATE_LIST(LIMIT, OLDLIST, NEWLIST) -- return NEWLIST =
                                               (OLDLIST up to LIMIT chars) ***/
truncate_list(_LIM, OLD, OLD) :- spark_enabled, !.              /* CFR035 */
truncate_list(LIM, OLD, NEW) :-
        length(OLD, LEN),
        LEN=<LIM,
        !,
        NEW=OLD.
truncate_list(24, OLD, NEW) :-
        OLD=[A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4|_],
        NEW=[A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,B1,B2,B3,B4,B5,B6,B7,B8,B9,B0,C1,C2,C3,C4], !.
truncate_list(20, OLD, NEW) :-
        OLD=[A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,B1,B2,B3,B4,B5,B6,B7,B8,B9,B0|_],
        NEW=[A1,A2,A3,A4,A5,A6,A7,A8,A9,A0,B1,B2,B3,B4,B5,B6,B7,B8,B9,B0], !.
truncate_list(LIM, OLD, NEW) :-
        length(OLD,LEN),
        LEN>LIM,
        NUM_TO_REMOVE is LEN-LIM,
        chop_off(NUM_TO_REMOVE, OLD, NEW),
        !.


/*** CHOP_OFF(NUMBER, OLDLIST, NEWLIST) -- chop NUMBER elements off tail ***/
chop_off(1,OLD,NEW) :- append(NEW,[_],OLD), !.
chop_off(2,OLD,NEW) :- append(NEW,[_,_],OLD), !.
chop_off(3,OLD,NEW) :- append(NEW,[_,_,_],OLD), !.
chop_off(4,OLD,NEW) :- append(NEW,[_,_,_,_],OLD), !.
chop_off(5,OLD,NEW) :- append(NEW,[_,_,_,_,_],OLD), !.
chop_off(6,OLD,NEW) :- append(NEW,[_,_,_,_,_,_],OLD), !.
chop_off(7,OLD,NEW) :- append(NEW,[_,_,_,_,_,_,_],OLD), !.
chop_off(8,OLD,NEW) :- append(NEW,[_,_,_,_,_,_,_,_],OLD), !.
chop_off(9,OLD,NEW) :- append(NEW,[_,_,_,_,_,_,_,_,_],OLD), !.
chop_off(N,_,_) :- N=<0, !, fail.
chop_off(N,OLD,NEW) :-
        N1 is N-9,
        chop_off(N1,OLD,NEW1),
        chop_off(9,NEW1,NEW),
        !.


/*** PROCESS_FDL_DEC(DECLARATION) ***/
process_fdl_dec([title | TITLEWORDS]) :-
        make_title_name(TITLEWORDS, TITLE),
        asserta(fdl_file_title(TITLE)),
        !.
process_fdl_dec([proof | DECLARATION]) :-
        process_fdl_dec(DECLARATION),
        !.
process_fdl_dec([var, VAR, ':', TYPE, ';']) :-
        find_core_type(TYPE, CORE_TYPE),
        maybe_add(var_const(VAR, CORE_TYPE, v)),
        save_used_identifier(VAR, var_const),
        !.
process_fdl_dec([const, CONST, ':', TYPE, '=' | _VALUE]) :-
        find_core_type(TYPE, CORE_TYPE),
        maybe_add(var_const(CONST, CORE_TYPE, c)),
        save_used_identifier(CONST, var_const),
        !.
process_fdl_dec([type, TYPE, '=', LOWER, '.', '.', UPPER, ';']) :-
        handle_negatives_etc(LOWER, LOW),                       /* CFR056 */
        handle_negatives_etc(UPPER, UPP),                       /* CFR056 */
        checktype(LOW, RANGE_TYPE),                             /* CFR056 */
        checktype(UPP, RANGE_TYPE),                             /* CFR056 */
        !,
        maybe_add(type_alias(TYPE, RANGE_TYPE)),
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([type, TYPE, '=', '-', LOWER, '.', '.', UPPER, ';']) :- /*056*/
        handle_negatives_etc(UPPER, UPP),                       /* CFR056 */
        checktype(-LOWER, RANGE_TYPE),                          /* CFR056 */
        checktype(UPP, RANGE_TYPE),                             /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', '+', LOWER, '.', '.', UPPER, ';']) :- /*056*/
        handle_negatives_etc(UPPER, UPP),                       /* CFR056 */
        checktype(LOWER, RANGE_TYPE),                           /* CFR056 */
        checktype(UPP, RANGE_TYPE),                             /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', LOWER, '.', '.', '-', UPPER, ';']) :- /*056*/
        handle_negatives_etc(LOWER, LOW),                       /* CFR056 */
        checktype(LOW, RANGE_TYPE),                             /* CFR056 */
        checktype(-UPPER, RANGE_TYPE),                          /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', LOWER, '.', '.', '+', UPPER, ';']) :- /*056*/
        handle_negatives_etc(LOWER, LOW),                       /* CFR056 */
        checktype(LOW, RANGE_TYPE),                             /* CFR056 */
        checktype(-UPPER, RANGE_TYPE),                          /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', '-', LOWER, '.', '.', '-', UPPER, ';']) :- /*056*/
        checktype(-LOWER, RANGE_TYPE),                          /* CFR056 */
        checktype(-UPPER, RANGE_TYPE),                          /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', '-', LOWER, '.', '.', '+', UPPER, ';']) :- /*056*/
        checktype(-LOWER, RANGE_TYPE),                          /* CFR056 */
        checktype(UPPER, RANGE_TYPE),                           /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', '+', LOWER, '.', '.', '-', UPPER, ';']) :- /*056*/
        checktype(LOWER, RANGE_TYPE),                           /* CFR056 */
        checktype(-UPPER, RANGE_TYPE),                          /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', '+', LOWER, '.', '.', '+', UPPER, ';']) :- /*056*/
        checktype(LOWER, RANGE_TYPE),                           /* CFR056 */
        checktype(UPPER, RANGE_TYPE),                           /* CFR056 */
        !,                                                      /* CFR056 */
        maybe_add(type_alias(TYPE, RANGE_TYPE)),                /* CFR056 */
        save_used_identifier(TYPE, type),                       /* CFR056 */
        !.                                                      /* CFR056 */
process_fdl_dec([type, TYPE, '=', pending, ';']) :-
        maybe_add(type(TYPE, abstract)),
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([type, TYPE, '=', ALIAS, ';']) :-
        maybe_add(type_alias(TYPE, ALIAS)),
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([type, TYPE, '=', array, '[' | REST]) :-
        process_array_list(REST, INDEX_TYPES, ELEM_TYPE),
        (
           type(OTHER_TYPE, array(INDEX_TYPES, ELEM_TYPE)),
           TYPE \= OTHER_TYPE,
           maybe_add(type_alias(TYPE, OTHER_TYPE))
        ;
           maybe_add(type(TYPE, array(INDEX_TYPES, ELEM_TYPE)))
        ),
        !,
        name(TYPE, TL),
        append("mk__", TL, MKFL),
        name(MK__FUNCTION, MKFL),
        maybe_add(mk__function_name(MK__FUNCTION, TYPE, array)),
        !,
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([type, TYPE, '=', '(' | REST]) :-
        process_enumeration_list(REST, ENUMERATION),
        maybe_add(type(TYPE, enumerated)),
        save_used_identifier(TYPE, type),
        maybe_add(enumeration(TYPE, ENUMERATION)),
        save_enumeration_constants(TYPE, ENUMERATION),
        !.
process_fdl_dec([type, TYPE, '=', record | REST]) :-
        process_record_fields(REST, FIELD_LIST),
        assertz(type(TYPE, record(FIELD_LIST))),
        save_used_identifier(TYPE, type),
        save_field_list(TYPE, FIELD_LIST),
        !,
        name(TYPE, TL),
        append("mk__", TL, MKFL),
        name(MK__FUNCTION, MKFL),
        maybe_add(mk__function_name(MK__FUNCTION, TYPE, record)),
        !.
process_fdl_dec([type, TYPE, '=', sequence, of, ELEMENT_TYPE, ';']) :-
        op(20,fy,TYPE),
        find_core_type(ELEMENT_TYPE, ELEM_TYPE),
        !,
        maybe_add(type(TYPE, sequence(ELEM_TYPE))),
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([type, TYPE, '=', set, of, ELEMENT_TYPE, ';']) :-
        op(20,fy,TYPE),
        find_core_type(ELEMENT_TYPE, ELEM_TYPE),
        !,
        maybe_add(type(TYPE, set(ELEM_TYPE))),
        save_used_identifier(TYPE, type),
        !.
process_fdl_dec([function, FUNCTION, '(' | REST]) :-
        process_function_list(REST, ARG_TYPES, RESULT_TYPE),
        maybe_add(function(FUNCTION, ARG_TYPES, RESULT_TYPE)),
        save_used_identifier(FUNCTION, function),
        save_function_template(FUNCTION, ARG_TYPES),
        !.
process_fdl_dec([function, CONST, ':', TYPE, ';']) :-
        find_core_type(TYPE, CORE_TYPE),
        maybe_add(var_const(CONST, CORE_TYPE, c)),
        save_used_identifier(CONST, var_const),
        !.
process_fdl_dec([var | REST]) :-
        process_var_list(REST, _TYPE),
        !.
process_fdl_dec([start | _]) :- !.
process_fdl_dec([end | _]) :- !.                                /* CFR046 */
process_fdl_dec([pre | _]) :- !.
process_fdl_dec([post | _]) :- !.
process_fdl_dec([derives | _]) :- !.


/*** MAYBE_ADD(FACT) -- add fact if not already known ***/
maybe_add(X) :-
        call(X),
        !.
maybe_add(X) :-
        assertz(X),
        !.


handle_negatives_etc(X, NEWX) :-                                /* CFR056 */
        atom(X),                                                /* CFR056 */
        name(X, XL),                                            /* CFR056 */
        (                                                       /* CFR056 */
           XL = [45|REST],      /* "-" */                       /* CFR056 */
           name(ID, REST),                                      /* CFR056 */
           NEWX = (- ID)                                        /* CFR056 */
        ;                                                       /* CFR056 */
           XL = [43|REST],      /* "+" */                       /* CFR056 */
           name(NEWX, REST)                                     /* CFR056 */
        ),                                                      /* CFR056 */
        !.                                                      /* CFR056 */
handle_negatives_etc(X, X) :- !.                                /* CFR056 */


/*** find_core_type(TYPE, CORE_TYPE) - return core alias or self in none ***/
find_core_type(TYPE, CORE_TYPE) :-
        type_alias(TYPE, CORE_TYPE),
        !.
find_core_type(TYPE, TYPE) :- !.


/*** save_enumeration_constants(TYPE, CONSTANTS_LIST) ***/
save_enumeration_constants(TYPE, [HEAD|TAIL]) :-
        maybe_add(var_const(HEAD, TYPE, c)),
        save_used_identifier(HEAD, var_const),
        !,
        save_enumeration_constants(TYPE, TAIL).
save_enumeration_constants(_TYPE, []) :- !.


/*** PROCESS_ARRAY_LIST(REST, INDEX_TYPES, ELEM_TYPE) ***/
process_array_list([INDEX, ']', of, ELEM_TYPE, ';'], [IND], EL_TYPE) :-
        find_core_type(INDEX, IND),
        find_core_type(ELEM_TYPE, EL_TYPE),
        !.
process_array_list([INDEX, ',' | REST], [IND|OTHER_INDS], ELEM_TYPE) :-
        find_core_type(INDEX, IND),
        process_array_list(REST, OTHER_INDS, ELEM_TYPE),
        !.


/*** PROCESS_ENUMERATION_LIST(REST, ENUMERATION) ***/
process_enumeration_list([CONST, ')', ';'], [CONST]) :-
        !.
process_enumeration_list([CONST, ',' | REST], [CONST|OTHER_CONSTS]) :-
        process_enumeration_list(REST, OTHER_CONSTS),
        !.


/*** PROCESS_RECORD_FIELDS(REST, FIELD_LIST) ***/
process_record_fields([FIELD1, ',', FIELD2 | REST], FIELD_LIST) :-  /* CFR033 */
        !,                                                      /* CFR033 */
        rewrite_record_field_list([FIELD1, ',', FIELD2| REST], NEW_LIST),
        !,
        process_record_fields(NEW_LIST, FIELD_LIST),            /* CFR033 */
        !.                                                      /* CFR033 */
process_record_fields([FIELD_TAG, ':', TYPE, end, ';'], [[FIELD_TAG, CTYPE]]) :-
        find_core_type(TYPE, CTYPE),
        !.
process_record_fields([FIELD_TAG, ':', TYPE, ';'], [[FIELD_TAG, CTYPE]|REST]) :-
        find_core_type(TYPE, CTYPE),
        get_fdl_declaration(NEXT_FIELD_DEC),
        process_record_fields(NEXT_FIELD_DEC, REST),
        !.
process_record_fields([FIELD_TAG, ':', TYPE, ';' | MORE],       /* CFR033 */
                      [[FIELD_TAG, CTYPE] | REST]) :-           /* CFR033 */
        MORE \= [],                                             /* CFR033 */
        !,                                                      /* CFR033 */
        find_core_type(TYPE, CTYPE),                            /* CFR033 */
        process_record_fields(MORE, REST),                      /* CFR033 */
        !.                                                      /* CFR033 */


/* rewrite_record_field_list(TOKEN_LIST, NEW_TOKEN_LIST) */     /* CFR033 */
rewrite_record_field_list([F1,',',F2,':',T|REST],               /* CFR033 */
                          [F1,':',T,';',F2,':',T|REST]) :- !.   /* CFR033 */
rewrite_record_field_list([F1,',',F2|REST],                     /* CFR033 */
                          [F1,':',T,';',F2,':',T|TAIL]) :-      /* CFR033 */
        !,                                                      /* CFR033 */
        rewrite_record_field_list([F2|REST],[F2,':',T|TAIL]),   /* CFR033 */
        !.                                                      /* CFR033 */


/*** PROCESS_FUNCTION_LIST(REST, ARG_TYPES, RESULT_TYPE) ***/
process_function_list([ARG_TYPE, ')', ':', RESULT_TYPE, ';'],
                      [CORE_ARG_TYPE], CORE_RESULT_TYPE) :-
        find_core_type(ARG_TYPE, CORE_ARG_TYPE),
        find_core_type(RESULT_TYPE, CORE_RESULT_TYPE),
        !.
process_function_list([ARG_TYPE, ','|REST], [C_ARG_TYPE|OTHERS], RESULT_TYPE) :-
        find_core_type(ARG_TYPE, C_ARG_TYPE),
        !,
        process_function_list(REST, OTHERS, RESULT_TYPE),
        !.


/*** PROCESS_VAR_LIST(REST) ***/
process_var_list([VAR, ':', TYPE, ';'], CORE_TYPE) :-
        find_core_type(TYPE, CORE_TYPE),
        maybe_add(var_const(VAR, CORE_TYPE, v)),
        save_used_identifier(VAR, var_const),
        !.
process_var_list([VAR, ',' | REST], TYPE) :-
        process_var_list(REST, TYPE),
        maybe_add(var_const(VAR, TYPE, v)),
        save_used_identifier(VAR, var_const),
        !.


save_used_identifier(IDENTIFIER, record_function) :-            /* CFR029 */
        used_ident(IDENTIFIER, record_function),                /* CFR029 */
        !.                                                      /* CFR029 */
save_used_identifier(IDENTIFIER, _CLASS) :-
        used_ident(IDENTIFIER, _),
        !,
        write('!!! FATAL-ERROR: Identifier declared multiple times - '),
        print(IDENTIFIER),
        nl,
        !,
        maybe_halt.
save_used_identifier(IDENTIFIER, _CLASS) :-
        built_in_ident(IDENTIFIER),
        !,
        write('!!! FATAL-ERROR: Identifier reserved or already predeclared - '),
        print(IDENTIFIER),
        nl,
        !,
        maybe_halt.
save_used_identifier(IDENTIFIER, CLASS) :-
        assertz(used_ident(IDENTIFIER, CLASS)),
        !.


maybe_halt :-
        vc(_, _),               /* so we're interactive... */
        !.                      /* just have to continue!! */
maybe_halt :-
        write('CANNOT CONTINUE: Proof session terminated.'),
        nl,
        !,
        close_all_streams,
        halt.


built_in_ident(update).
built_in_ident(element).
built_in_ident(set).
built_in_ident(succ).
built_in_ident(pred).
built_in_ident(first).
built_in_ident(last).
built_in_ident(nonfirst).
built_in_ident(nonlast).
built_in_ident(abs).
built_in_ident(sqr).
built_in_ident(odd).
built_in_ident(div).
built_in_ident(mod).
built_in_ident(subset_of).
built_in_ident(strict_subset_of).
built_in_ident(true).
built_in_ident(false).
built_in_ident(integer).
built_in_ident(boolean).
built_in_ident(real).
built_in_ident(in).
built_in_ident(not_in).
built_in_ident(and).
built_in_ident(or).
built_in_ident(not).


/*** make_title_name(TITLEWORDS, TITLE) -- build VC title component ***/
make_title_name([TITLE, ';'], TITLE) :- !.
make_title_name([';'], vc) :- !.
make_title_name([], vc) :- !.
make_title_name([WORD|REST], TITLE) :-
        make_title_name(REST, RESTNAME),
        name(WORD, WL),
        name(RESTNAME, RL),
        append(WL,[95|RL], TL),
        name(TITLE, TL),
        !.


/*** FGET0(CHAR) - get & echo next non-comment character ***/
fget0(CHAR) :-
        eget0(CH),
        (
           CH\=123,                     /* { */
           CHAR=CH
        ;
           CH=123,
           skip_to_end_of_comment,
           fget0(CHAR)
        ),
        !.


/*** SKIP_TO_END_OF_COMMENT - find '}' at end of comment ***/
skip_to_end_of_comment :-
        repeat,
           eget0(CHAR),
        /* UNTIL */ CHAR = 125,         /* } */
        !.

increment_current_record_field_number :-
        retract(current_record_field_number(N)),
        M is N+1,
        asserta(current_record_field_number(M)),
        !.

/*** SAVE_FIELD_LIST(TYPE, FIELDS_LIST) -- create functions and store ***/
save_field_list(TID,[[FD,FT]]) :-
    name(FD,L),
    truncate_list(20,L,L1),
    append("upf_",L1,UL),
    name(UPF,UL),
    assertz(function(UPF,[TID,FT],TID)),
    save_used_identifier(UPF, record_function),                 /* CFR029 */
    UFUN=..[UPF,A1,A2],
    current_record_field_number(CRFN),
    add_new_record_function(UFUN,CRFN,update,FD,[A1,A2],TID),   /* CFR029 */
    append("fld_",L1,CL),
    name(FLD,CL),
    assertz(function(FLD,[TID],FT)),
    save_used_identifier(FLD, record_function),                 /* CFR029 */
    CFUN=..[FLD,A1],
    add_new_record_function(CFUN,CRFN,access,FD,[A1],TID),              /* CFR029 */
    !.

save_field_list(TID,[[FD,FT]|FL]) :-
    name(FD,L),
    truncate_list(20,L,L1),
    append("upf_",L1,UL),
    name(UPF,UL),
    assertz(function(UPF,[TID,FT],TID)),
    save_used_identifier(UPF, record_function),                 /* CFR029 */
    UFUN=..[UPF,A1,A2],
    current_record_field_number(CRFN),
    add_new_record_function(UFUN,CRFN,update,FD,[A1,A2],TID),   /* CFR029 */
    append("fld_",L1,CL),
    name(FLD,CL),
    assertz(function(FLD,[TID],FT)),
    save_used_identifier(FLD, record_function),                 /* CFR029 */
    CFUN=..[FLD,A1],
    add_new_record_function(CFUN,CRFN,access,FD,[A1],TID),              /* CFR029 */
    !,
    increment_current_record_field_number,
    !,
    save_field_list(TID,FL),
    !.


/*** ADD_NEW_RECORD_FUNCTION(FUNCTION, START) -- save record function ***/
add_new_record_function(FUNCTION, START, MODE, FIELD, ARGS, TYPE) :-  /*CFR029*/
    record_function(START,_,MODE,_,_,TYPE),                     /* CFR029 */
    !,
    write('Warning - record field number already used.'),
    !,
    NEWSTART is START+1,
    add_new_record_function(FUNCTION, NEWSTART, MODE, FIELD, ARGS, TYPE), /*29*/
    !.
add_new_record_function(FUNCTION, START, MODE, FIELD, ARGS, TYPE) :-  /*CFR029*/
    assertz(record_function(START,FUNCTION,MODE, FIELD, ARGS, TYPE)), /*CFR029*/
    !.


save_function_template(FUNCTION, ARG_TYPES) :-
        length(ARG_TYPES, LENGTH),
        form_function_var_list(LENGTH, VAR_LIST),
        FUNCTION_CALL =.. [FUNCTION|VAR_LIST],
        assertz(function_template(FUNCTION_CALL, VAR_LIST, FUNCTION)),
        !.


form_function_var_list(1,  [_]) :- !.
form_function_var_list(2,  [_,_]) :- !.
form_function_var_list(3,  [_,_,_]) :- !.
form_function_var_list(4,  [_,_,_,_]) :- !.
form_function_var_list(5,  [_,_,_,_,_]) :- !.
form_function_var_list(6,  [_,_,_,_,_,_]) :- !.
form_function_var_list(7,  [_,_,_,_,_,_,_]) :- !.
form_function_var_list(8,  [_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(9,  [_,_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(10, [_,_,_,_,_,_,_,_,_,_]) :- !.
form_function_var_list(N, [_,_,_,_,_|X]) :-
        N>10, N1 is N-5, !, form_function_var_list(N1, X), !.
form_function_var_list(0, []) :- !.     /* Shouldn't ever get here anyway! */


/*** LOAD_VCS(FILENAME) -- load the VCs from the modified .VCG file ***/
load_vcs(VCGFILE) :-
    see(VCGFILE),
    (
       echo(off)
    ;
       nl, nl
    ),
    retractall(current_vc_no(_)),
    asserta(current_vc_no(0)),                                  /* CFR034 */
    skip_initial_crap,
    read_vcs,
    seen,
    !.


/*** SCAN_FILE_HEADER_TO_SEE_IF_SPARK(FILENAME) -- look for keyword SPARK ***/
scan_file_header_to_see_if_spark(VCGFILE) :-                    /* CFR035 */
    see(VCGFILE),                                               /* CFR035 */
    mini_skip_initial_crap,                                     /* CFR035 */
    seen,                                                       /* CFR035 */
    !.


/*** read_vcs -- repeatedly get the next VC ***/
read_vcs :-
    eof_char(EOF),
    repeat,
        increment_vc_number,                                    /* CFR034 */
        get_next_vc(C),
    /* until */ C==EOF,                                         /* CFR034 */
    current_vc_no(N),
    M is N-1,
    make_numbers_list(1,M,LIST),
    remove_true_vcs_from_numbers_list([LIST], REVISED_LIST),    /* CFR004 */
    assertz(vcs_to_prove(REVISED_LIST)),                        /* CFR004 */
    !.


/* increment_vc_number */                                       /* CFR034 */
increment_vc_number :-                                          /* CFR034 */
        retract(current_vc_no(N)),                              /* CFR034 */
        M is N+1,                                               /* CFR034 */
        asserta(current_vc_no(M)),                              /* CFR034 */
        !.                                                      /* CFR034 */


/*** get_next_vc(NEXT_CHAR) -- get & save next vc and return next character ***/
get_next_vc(NEXT_CHAR) :-
        eof_char(EOF),
        repeat,                                                 /* CFR034 */
           read_and_echo_vc_line(L),                            /* CFR034 */
        /* until */ ( is_terminator_line(L, NEXT_CHAR) ;        /* CFR034 */
                      is_vc_line(L) ),                          /* CFR034 */
        !,                                                      /* CFR034 */
        current_vc_no(N),
        fdl_file_title(TITLE),
        makename(TITLE,N,VCNAME),
        !,                                                      /* CFR034 */
        (                                                       /* CFR034 */
           NEXT_CHAR == EOF                                     /* CFR034 */
        ;                                                       /* CFR034 */
           read_verification_condition(VCNAME)                  /* CFR034 */
        ),                                                      /* CFR034 */
        !.                                                      /* CFR034 */

/* read_and_echo_vc_line(L) */                                  /* CFR034 */
read_and_echo_vc_line(L) :-                                     /* CFR034 */
        eof_char(EOF),
        eol_char(EOL),
        eget0(C),                                               /* CFR034 */
        !,                                                      /* CFR034 */
        (                                                       /* CFR034 */
           C = EOL,                                             /* CFR034 */
           L = []                                               /* CFR034 */
        ;                                                       /* CFR034 */
           C = EOF,                                             /* CFR034 */
           L = [EOF]                                            /* CFR034 */
        ;                                                       /* CFR034 */
           L = [C|REST],                                        /* CFR034 */
           !,                                                   /* CFR034 */
           read_and_echo_vc_line(REST)                          /* CFR034 */
        ),                                                      /* CFR034 */
        !.                                                      /* CFR034 */


/* read_vc_line_noecho(L) */                                    /* CFR035 */
read_vc_line_noecho(L) :-                                       /* CFR035 */
        eof_char(EOF),
        eol_char(EOL),
        get_code(C),                                            /* CFR035 */
        !,                                                      /* CFR035 */
        (                                                       /* CFR035 */
           C = EOL,                                             /* CFR035 */
           L = []                                               /* CFR035 */
        ;                                                       /* CFR035 */
           C = EOF,                                             /* CFR035 */
           L = [EOF]                                            /* CFR035 */
        ;                                                       /* CFR035 */
           L = [C|REST],                                        /* CFR035 */
           !,                                                   /* CFR035 */
           read_vc_line_noecho(REST)                            /* CFR035 */
        ),                                                      /* CFR035 */
        !.                                                      /* CFR035 */


/* is_terminator_line(L, EOF) */                                        /* CFR034 */
is_terminator_line(L, EOF) :-                                   /* CFR034 */
        eof_char(EOF),
        is_in(EOF, L),                                          /* CFR034 */
        !.                                                      /* CFR034 */


/* is_vc_line(L) */                                             /* CFR034 */
is_vc_line(L) :-                                                /* CFR034 */
        triple_append(FRONT_PART, "_", DIGITS_AND_DOT, L),      /* CFR034 */
        is_digits_and_dot(DIGITS_AND_DOT),                      /* CFR034 */
        is_ok_front_part_of_vc_line(FRONT_PART),                /* CFR034 */
        !.                                                      /* CFR034 */


/* is_digits_and_dot(DIGITS_AND_DOT) */                         /* CFR034 */
is_digits_and_dot(DIGITS_AND_DOT) :-                            /* CFR034 */
        gen_append(DIGITS, ".", DIGITS_AND_DOT),                /* CFR034 */
        are_all_digits(DIGITS).                                 /* CFR034 */


/* are_all_digits(DIGIT_LIST) */                                /* CFR034 */
are_all_digits([H|T]) :-                                        /* CFR034 */
        48 =< H, H =< 57, !, are_all_digits(T).                 /* CFR034 */
are_all_digits([]) :- !.                                        /* CFR034 */


/* is_ok_front_part_of_vc_line(LIST_OF_CHARS) */                /* CFR034 */
is_ok_front_part_of_vc_line([H|_T]) :-                          /* CFR034 */
        (                                                       /* CFR034 */
           48 =< H, H =< 57                                     /* CFR034 */
        ;                                                       /* CFR034 */
           65 =< H, H =< 90                                     /* CFR034 */
        ;                                                       /* CFR034 */
           97 =< H, H =< 122                                    /* CFR034 */
        ;                                                       /* CFR034 */
           [H] = "_"                                            /* CFR034 */
        ),                                                      /* CFR034 */
        !.                                                      /* CFR034 */
is_ok_front_part_of_vc_line([]) :- !.                           /* CFR034 */


/* read_verification_condition(VCNAME) */                       /* CFR034 */
read_verification_condition(VCNAME) :-                          /* CFR034 */
        repeat,                                                 /* CFR034 */
           eget0(CHAR),                                         /* CFR034 */
           process_rest_of_component(VCNAME, CHAR, FINISHED),   /* CFR034 */
        /* until */ FINISHED,                                   /* CFR034 */
        (                                                       /* CFR034 */
           is_true_vc(_, VCNAME)                                /* CFR034 */
        ;                                                       /* CFR034 */
           assertz(is_vc(VCNAME))                               /* CFR034 */
        ),                                                      /* CFR034 */
        !.                                                      /* CFR034 */


process_rest_of_component(VCNAME, CHAR, FINISHED) :-
        eol_char(EOL),                                          /* CFR034 */
        (
           ( CHAR = 32 ; CHAR = EOL ),                          /* CFR034 */
           eget0(NEXT_CHAR),                                    /* CFR034 */
           (                                                    /* CFR052 */
              NEXT_CHAR = EOL                               /* CFR034,052 */
           ;                                                    /* CFR052 */
              CHAR = EOL,                                       /* CFR052 */
              NEXT_CHAR = 32                                    /* CFR052 */
           ),                                                   /* CFR052 */
           !,                                                   /* CFR034 */
           FINISHED = true                                      /* CFR034 */
        ;                                                       /* CFR034 */
           CHAR=42,             /* "*" */
           find_char(EOL),                                      /* CFR034 */
           find_char(EOL),                                      /* CFR034 */
           current_vc_no(N),                                    /* CFR004,034 */
           assertz(is_true_vc(N, VCNAME)),                      /* CFR004 */
           FINISHED = true                                      /* CFR034 */
        ;
           CHAR=33,             /* "!" */
           find_char(EOL),                                      /* CFR034 */
           find_char(EOL),                                      /* CFR034 */
           write('!!! WARNING: UNPROVEABLE VC!  Suggest you take corrective action.'),
           nl,
           assertz(vc(VCNAME,conc(1,false))),
           FINISHED = true                                      /* CFR034 */
        ;
           eof_char(EOF),
           CHAR = EOF,  /* shouldn't, but just in case! */      /* CFR034 */
           FINISHED = true                                      /* CFR034 */
        ;                                                       /* CFR034 */
           FINISHED = fail,                                     /* CFR034 */
           (                                                    /* CFR034 */
              (                                                 /* CFR034 */
                 CHAR=72,               /* "H" */               /* CFR034 */
                 F=hyp                                          /* CFR034 */
              ;                                                 /* CFR034 */
                 CHAR=67,               /* "C" */               /* CFR034 */
                 F=conc                                         /* CFR034 */
              ),                                                /* CFR034 */
              read_component_number(N),                         /* CFR034 */
              eread(FORM),                                      /* CFR034 */
              process_formula(FORM,FORMULA),                    /* CFR034 */
              COMPONENT=..[F,N,FORMULA],                        /* CFR034 */
              assertz(vc(VCNAME,COMPONENT))                     /* CFR034 */
           ;                                                    /* CFR034 */
              CHAR=32,          /* " " not followed by <CR> */  /* CFR034 */
              find_char(EOL)                                    /* CFR034 */
           ;                                                    /* CFR034 */
              true                                              /* CFR034 */
           )                                                    /* CFR034 */
        ), !.


/*** process_formula(OLD,NEW) -- filter & simplify OLD to get NEW ***/
process_formula(OLD_FORMULA, NEW_FORMULA) :-
        (
           novars(OLD_FORMULA)
        ;
           nl,
           write('*** ABORTED: Prolog variables occur in formula.'),
           nl,
           close_all_streams,
           halt
        ),
        !,
        (
           restructure_formula(OLD_FORMULA, INTERMEDIATE)
        ;
           nl,
           write('*** ABORTED: could not restructure above formula.'),
           nl,
           close_all_streams,
           halt
        ),
        !,
        (
           typechecking_during_load(on),
           (
              checktype(INTERMEDIATE, boolean)
           ;
              write('*** ABORTED: above formula did not typecheck as boolean.'),
              nl,
              !,
              close_all_streams,
              halt
           )
        ;
           true
        ),
        !,
        (
           simplify_during_load(on),
           (
              simplify(INTERMEDIATE, NEW_FORMULA)
           ;
              nl,
              write('!!! WARNING: Could not simplify above formula properly.'),
              nl,
              NEW_FORMULA=INTERMEDIATE
           )
        ;
           NEW_FORMULA=INTERMEDIATE
        ),
        !.


/*** restructure_formula(OLD,NEW) -- no ~, set & seq prefix changes ***/

% In the simplifier, the restructured quantified expression adopts the
% discovered core type. This minor simplification has not been adopted in
% the checker, to reduce the risk of breaking existing proof scripts.
restructure_formula(for_all(V:T, P), for_all(V:T, 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
           )
        ),
        !.
% In the simplifier, the restructured quantified expression adopts the
% discovered core type. This minor simplification has not been adopted in
% the checker, to reduce the risk of breaking existing proof scripts.
restructure_formula(for_some(V:T, P), for_some(V:T, 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) :-                                        /*1.4*/
        restructure_formula(X, NEWX),                                   /*1.4*/
        restructure_formula(Y, NEWY),                                   /*1.4*/
        !,                                                              /*1.4*/
        checktype(X, TX),                                               /*1.4*/
        checktype(Y, TY),                                               /*1.4*/
        !,                                                              /*1.4*/
        (                                                               /*1.4*/
           TX = integer,                                                /*1.4*/
           TY = integer,                                                /*1.4*/
           integer(NEWX),
           integer(NEWY),
           NEWY \= 0,
           NEW iss (NEWX div NEWY),                                     /*1.4*/
           NEWX =:= NEW * NEWY  /* only if Y divides X */               /*1.4*/
        ;                                                               /*1.4*/
           NEW = (NEWX / NEWY)                                          /*1.4*/
        ),                                                              /*1.4*/
        !.                                                              /*1.4*/
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(succ(X), succ(NEWX)) :-
        restructure_formula(X, NEWX),
        !.
restructure_formula(pred(X), pred(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~), NV) :-
        twiddles_conversion(X, NV), !.
restructure_formula((X~), NV) :-
        atom(X),
        name(X,XL),
        append(XL,"__OLD",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, X) :- atomic(X), !.
restructure_formula(+X, Y) :- restructure_formula(X, Y), !.     /* CFR039 */
restructure_formula(X, NEWX) :-
        nonvar(X),
        X =.. [F|ARGS],
        spark_enabled,
        (
           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, _),                     /* CFR029,053 */
        !,
        restructure_formula_list(XL, YL),
        record_function(K, Y, _, F, YL, _),                     /* CFR029,053 */
        !.
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)
        ;
           (
              OP = mk__array,                                   /* CFR034 */
              spark_enabled,                                    /* CFR034 */
              !,                                                /* CFR034 */
              restructure_array_aggregate(XARGS, YARGS)         /* CFR034 */
           ;                                                    /* CFR034 */
              OP = mk__record,                                  /* CFR034 */
              spark_enabled,                                    /* CFR034 */
              !,                                                /* CFR034 */
              restructure_record_aggregate(XARGS, YARGS)        /* CFR034 */
           ;                                                    /* CFR034 */
              restructure_formula_list(XARGS, YARGS)            /* CFR034 */
           ),                                                   /* CFR034 */
           Y=..[OP|YARGS]                                       /* CFR034 */
        ), !.


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]) :-                  /* CFR034 */
        (                                                       /* CFR034 */
           X = (IND := EXPR),                                   /* CFR034 */
           !,                                                   /* CFR034 */
           restructure_formula(EXPR, NEWEXPR),                  /* CFR034 */
           !,                                                   /* CFR034 */
           (                                                    /* CFR034 */
              IND = (IND1 & IND2),                              /* CFR034 */
              restructure_indices(IND1, NEWIND1),               /* CFR034 */
              restructure_indices(IND2, NEWIND2),               /* CFR034 */
              !,                                                /* CFR034 */
              NEWIND = (NEWIND1 & NEWIND2)                      /* CFR034 */
           ;                                                    /* CFR034 */
              IND = [LO .. HI],                                 /* CFR034 */
              restructure_formula(LO, NEWLO),                   /* CFR034 */
              restructure_formula(HI, NEWHI),                   /* CFR034 */
              !,                                                /* CFR034 */
              NEWIND = [NEWLO .. NEWHI]                         /* CFR034 */
           ;                                                    /* CFR034 */
              IND = [I],                                        /* CFR034 */
              restructure_formula(I, NEWI),                     /* CFR034 */
              !,                                                /* CFR034 */
              NEWIND = [NEWI]                                   /* CFR034 */
           ),                                                   /* CFR034 */
           !,                                                   /* CFR034 */
           Y = (NEWIND := NEWEXPR)                              /* CFR034 */
        ;                                                       /* CFR034 */
           restructure_formula(X, Y)                            /* CFR034 */
        ),                                                      /* CFR034 */
        !,                                                      /* CFR034 */
        restructure_array_aggregate(XL, YL),                    /* CFR034 */
        !.                                                      /* CFR034 */
restructure_array_aggregate([], []) :- !.                       /* CFR034 */


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


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


/*** read_component_number(NO) -- get number of hypothesis/conclusion ***/
read_component_number(NUMBER) :-
        read_number_codes(CODES),
        name(NUMBER, CODES),
        !.


/*** read_number_codes(CODELIST) -- read codes until hitting a colon ***/
read_number_codes(CODES) :-
        eget0(CHAR),
        (
           CHAR=58,
           !,
           CODES=[],
           put_code(32),
           put_code(32)
        ;
           read_number_codes(REST),
           CODES=[CHAR|REST]
        ), !.


/*** MAKENAME(TITLE,NUMBER,VCNAME) -- create a unique VC name for VC ***/
makename(TITLE,N,VCNAME) :-
    codelist(N,BACK),
    name(TITLE,FRONT),
    append(FRONT,[95|BACK],VCL),
    name(VCNAME,VCL), !.


/*** CODELIST(NUMBER,LIST) -- break NUMBER into LIST of ASCII codes ***/
codelist(N,[M]) :-
    N>=0,
    N=<9,
    M is 48+N, !.
codelist(N,C) :-
    N>=10,
    M iss N div 10,
    codelist(M,C1),
    C2 is (N mod 10)+48,
    append(C1,[C2],C), !.


/*** make_numbers_list(L,U,LIST) - make a list of the numbers in L..U ***/
make_numbers_list(L,U,[]) :- L>U, !.
make_numbers_list(L,L,[L]) :- !.
make_numbers_list(L,U,[L|LIST]) :- L1 is L+1, make_numbers_list(L1,U,LIST), !.


/*** SKIP_INITIAL_CRAP -- read past banner ***/
skip_initial_crap :-                                            /* CFR034 */
        read_and_echo_vc_line(_Line1),                          /* CFR034 */
        read_and_echo_vc_line(_Line2),                          /* CFR034 */
        read_and_echo_vc_line(_Line3),                          /* CFR034 */
        read_and_echo_vc_line(_Line4),                          /* CFR034 */
        read_and_echo_vc_line(_Line5),                          /* CFR034 */
        read_and_echo_vc_line(_Line6),                          /* CFR034 */
        read_and_echo_vc_line(_Line7),                          /* CFR034 */
        read_and_echo_vc_line(_Line8),                          /* CFR034 */
        read_and_echo_vc_line(_Line9),                          /* CFR034 */
        read_and_echo_vc_line(_Line10),                         /* CFR034 */
        read_and_echo_vc_line(_Line11),                         /* CFR034 */
        read_and_echo_vc_line(_Line12),                         /* CFR034 */
        read_and_echo_vc_line(_Line13),                         /* CFR034 */
        fail.                                                   /* CFR034 */
skip_initial_crap :- !.                                         /* CFR034 */


/*** MINI_SKIP_INITIAL_CRAP -- read top of banner to see if SPARK ***/
mini_skip_initial_crap :-                                       /* CFR035 */
        read_vc_line_noecho(_Line1),                            /* CFR035 */
        read_vc_line_noecho(_Line2),                            /* CFR035 */
        read_vc_line_noecho(Line3),                             /* CFR035 */
        scan_line_three_for_SPARK_marque(Line3),                /* CFR035 */
        !.                                                      /* CFR035 */


/* scan_line_three_for_SPARK_marque(L) */
scan_line_three_for_SPARK_marque(L) :-
        (
            triple_append(_, "Examiner", _, L)                  /* now */
        ;
            triple_append(_, "SPARK", _, L)                     /* previously */
        ),
        !,
        assert(spark_enabled).
scan_line_three_for_SPARK_marque(_L) :- !.


/*** FIND_CHAR(N) -- repeatedly fetch characters until hit next char N ***/
find_char(N) :-
    repeat,
       eget0(C),
    /* until */ C=N, !.


% Note POGS collects both the DATE and TIME, and expects the following format.
%
% Once all trailing and leading space has been deleted:
%
% The text 'DATE' must occur in column: 1..4.
%
% The date format is like: 09-JAN-1980
% The time format is like: 01:59:01
%
% The date must start on column: 8 and be 11 chars wide.
% The time must start on column: 28 and be 8 chars wide.
%
% Currently, where the text 'DATE' is detected, POGS semantically compares the
% items parsed against the date embedded into the SIV file.

/*** WRITE_PROOF_LOG_BANNER -- write banner heading to proof log ***/
write_proof_log_banner :-
        logfile_name(PROOFLOG),
        file_can_be_written(PROOFLOG),
        plain_output(off),
        !,
        tell(PROOFLOG),
        write('*****************************************************************************'),
        nl,
        write('SPADE Transcript of Interactive Proof Session'),
        nl,
        nl,
        current_output(Stream),
        display_header(Stream),
        nl,
        write('*****************************************************************************'),
        nl,
        fetch_date_and_time(DATE, TIME),
        nl,
        write('DATE : '),
        print(DATE),
        write('  TIME : '),
        print(TIME),
        nl,
        nl,
        tell(user),
        !.
write_proof_log_banner :-
        logfile_name(PROOFLOG),
        file_can_be_written(PROOFLOG),
        plain_output(on),
        !,
        tell(PROOFLOG),
        write('*****************************************************************************'),
        nl,
        write('SPADE Transcript of Interactive Proof Session'),
        nl,
        nl,
        current_output(Stream),
        display_header(Stream),
        nl,
        write('*****************************************************************************'),
        nl,
        nl,
        nl,
        nl,
        tell(user),
        !.
write_proof_log_banner :-
        logfile_name(PROOFLOG),
        \+ file_can_be_written(PROOFLOG),
        nl,
        write('Aborted: '),
        print(PROOFLOG),
        write(' cannot be written.'),
        nl,
        !,
        close_all_streams,
        halt.


/*** EGET0(CHAR) -- get, and optionally echo, character from file ***/
eget0(C) :- in_declare_command, !, lget0(C).                    /* CFR030 */
eget0(C) :- get_code(C), echo_char(C), !.

/*** EREAD(TERM) -- read, and optionally echo, term from file ***/
eread(V) :- read_term_and_layout(V), echo_term(V), !.


/*** ECHO_CHAR(CHAR) -- echo character when echoing is on ***/
echo_char(EOF) :- eof_char(EOF), !.                             /* CFR034 */
echo_char(C) :-
        echo(on),
        put_code(C),
        !.
echo_char(_) :- !.


/*** ECHO_TERM(TERM) -- echo term when echoing is on ***/
echo_term(end_of_file) :- !.
echo_term(V) :-
        echo(on),
        print(V),
        write('.'),
        nl,
        !.
echo_term(_) :- !.


/*** FORMAT_FORMULA(VC) -- save VC as hypotheses and conclusions ***/
format_formula(MS, X->Y) :-                                         /* CFR054 */
    !,
    layout(MS, hyp, X),
    !,
    layout(MS, conc, Y),
    !.
format_formula(MS, Y) :-                                            /* CFR054 */
    layout(MS, conc, Y),
    !.


/*** LAYOUT(HYP_OR_CONC, FORMULA) -- simplify, flatten and save the VC ***/
layout(MS, L, F) :-
    (
       simplify_in_infer(on),
       simplify(F,FF)
    ;
       FF = F
    ),
    !,
    flatten(FF,F1),
    !,
    store_vc(MS, L, 1, F1).

/*** FLATTEN(OLD, NEW) -- flatten out (& translate) formula ***/
flatten((A and B) and C,F) :-
    flatten(A and (B and C),F), !.
flatten((A or B) or C,F) :-
    flatten(A or (B or C),F), !.
flatten(A and B,A1 and B1) :-
    flatten(A,A1),
    flatten(B,B1), !.
flatten(A or B,A1 or B1) :-
    flatten(A,A1),
    flatten(B,B1), !.
flatten(not A,not A1) :-
    flatten(A,A1), !.
flatten(A -> F,A1 -> F1) :-
    flatten(A,A1),
    flatten(F,F1), !.
flatten(A <-> F,A1 <-> F1) :-
    flatten(A,A1),
    flatten(F,F1), !.
flatten(X,X) :- atomic(X), !.
flatten(X,Y) :-
    novars(X),
    X=..[OP|ArgsX],
    flattenlist(ArgsX,ArgsY),
    Y=..[OP|ArgsY],
    !.

flattenlist([],[]) :- !.
flattenlist([X|XL],[Y|YL]) :-
    flatten(X,Y),
    flattenlist(XL,YL),
    !.


/*** STORE_VC(HYP_OR_CONC,NUM,FORMULA) -- assert components into VC ***/
store_vc(MS,L,K,F and R) :-
    !,
    add_formula(MS,L,F),
    !,
    K1 is K+1,
    store_vc(MS,L,K1,R), !.
store_vc(MS,L,_K,F) :-
    !,
    add_formula(MS,L,F),
    !.


/*** add_formula(HYP_OR_CONC,FORMULA) -- add formula to current VC ***/
add_formula(logmessage,hyp,X) :- add_new_hyp(X,1), !.
add_formula(logmessage,conc,X) :- add_new_conc(X,1), !.
add_formula(nomessage,hyp,X) :- quiet_add_hyp(X,1), !.
add_formula(nomessage,conc,X) :- quiet_add_conc(X,1), !.


/*** QUIET_ADD_HYP(H,N) - adds formula H as the first free hypothesis number
     after N ***/
quiet_add_hyp(true,_) :- !.
quiet_add_hyp(H,1) :- hyp(_,H), !.
quiet_add_hyp(H,N) :- hyp(N,_), M is N+1, quiet_add_hyp(H,M), !.
quiet_add_hyp(H,N) :- assertz(hyp(N,H)), assertz(logfact(newhyp, hyp(N,H))),
                      stand_all, !.                             /* CFR018 */


/*** QUIET_ADD_CONC(C,N) - adds formula C as the first free conclusion number
     after N ***/
quiet_add_conc(C,N) :- conc(N,_), M is N+1, quiet_add_conc(C,M), !.
quiet_add_conc(C,N) :- assertz(conc(N,C)), assertz(logfact(newconc,conc(N,C))),
                       !.                                       /* CFR018 */


declare :-
        assert(in_declare_command),                             /* CFR030 */
        prompt_user('Please type your FDL-syntax declaration, terminated by a ";"','FDL> '),
        get_fdl_declaration(DECLARATION),
        !,
        process_fdl_dec(DECLARATION),
        retractall(in_declare_command),                         /* CFR030 */
        !.


/* remove_true_vcs_from_numbers_list(OLD_LIST, NEW_LIST) */
remove_true_vcs_from_numbers_list(LIST, REVISED_LIST) :-        /* CFR004 */
        retract(is_true_vc(N, VCNAME)),
        delete_number(N, LIST, NEW_LIST),
        assertz(logfact(true_vc, VCNAME)),
        update_vcs_proved(N),
        nl,
        write('+++ True VC '),
        print(VCNAME),
        write(' eliminated automatically.'),
        nl,
        !,
        remove_true_vcs_from_numbers_list(NEW_LIST, REVISED_LIST),
        !.
remove_true_vcs_from_numbers_list(LIST, LIST) :- !.
%###############################################################################
%END-OF-FILE
