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


:- use_module(library(lists)).
:- use_module(library(codesio)).
:- use_module(library(terms)).

/* Provides access to deprecated  *
 * 'system' library from SICStus3 */
:- use_module(library(system3)).


:- set_prolog_flag(syntax_errors, dec10).

/* Memory */

/* Setting of memory limit is TBD for SICSTUS */
set_memory_limit(_M) :- !.

/* Mathematics */

eval_div(X, Y, Z) :-
        Z is X // Y.

fetch_date_and_time(DATE, TIME) :-
        datime(datime(Year, Month, Day, Hour, Min, Sec)),
        number_codes(Year, [Y1, Y2, Y3, Y4]),
        (
            number_codes(Month, [M1, M2])
        ;
            number_codes(Month, [M2]),
            M1 = 48
        ),
        (
            number_codes(Day, [D1, D2])
        ;
            number_codes(Day, [D2]),
            D1 = 48
        ),
        (
            number_codes(Hour, [H1, H2])
        ;
            number_codes(Hour, [H2]),
            H1 = 48
        ),
        (
            number_codes(Min, [Mi1, Mi2])
        ;
            number_codes(Min, [Mi2]),
            Mi1 = 48
        ),
        (
            number_codes(Sec, [S1, S2])
        ;
            number_codes(Sec, [S2]),
            S1 = 48
        ),
        numeric_month_to_string([M1, M2], [MU1, MU2, MU3]),
        atom_codes(DATE, [D1,D2,45,MU1,MU2,MU3,45,Y1,Y2,Y3,Y4]),
        atom_codes(TIME, [H1, H2, 58, Mi1, Mi2, 58, S1, S2]),
        !.

get_command_line(DATA) :-
        prolog_flag(argv, DATA),
        !.


eof_char(-1). /* Always -1 on all SICSTUS platforms */

% All platforms have the same eol character.
eol_char(10).

:- set_prolog_flag(compiling, compactcode).

set_exit_status :- !.       /* TBD for SICSTUS */

/* In iso language mode, SICSTUS read/1 _doesn't_ consume layout by default, so we */
/* have to use the more flexible read_term/2 */
read_term_and_layout(V) :-
        read_term(A, [consume_layout(true)]),
        !,
        normalize_negative_literals(A, V).

/*** Succeeds iff FNAME denotes a readable, regular file */
file_exists_and_is_readable(FNAME) :-
        file_exists(FNAME, [exists]),
        file_exists(FNAME, [read]).

/*** Succeeds if file exists and can be written, or file does not exist */
file_can_be_written(FNAME) :-
        file_exists(FNAME, [exists]),
        file_exists(FNAME, [write]).
file_can_be_written(FNAME) :-
        \+ file_exists(FNAME).

/* get_file_attrib/3 for SICSTUS, where we want the full file-name only */
get_file_attrib(FNAME, [FULL_NAME|_], _) :-
        absolute_file_name(FNAME, FULL_NAME).

list_files_with_extension(Extension) :-
         name(Extension, ExtensionCharList),
         append(".", ExtensionCharList, DotExtensionCharList),
         /* Determine the current working directory*/
         working_directory(Dir, Dir),
         /* Find list of all files */
         directory_files(Dir, FileAtomList),
         /* Find list of files with appropriate extension. */
         filesWithExtension(FileAtomList, DotExtensionCharList, FilesMatchingList),
         (
             /* No matching files found. */
             FilesMatchingList=[],
             write('       <THERE ARE NONE>')
             ;
             /* Some matching files found */
             displayListOfFiles(FilesMatchingList)
         ),
         !,
         fail.

displayListOfFiles([]).

displayListOfFiles([H_FilesMatching | T_FilesMatchingList]) :-
         /* tab is obsolescent in SICSTUS but still works */
         tab(5),
         write(H_FilesMatching),
         nl,
         displayListOfFiles(T_FilesMatchingList).

filesWithExtension([], _, []).

filesWithExtension([H_InFileAtom | T_InFileAtomList],
                   DotExtensionCharList,
                   [H_OutFileAtom | T_OutFileAtomList]) :-
          name(H_InFileAtom, H_InFileCharList),
          /* Check this has suffix looking for */
          /* Does have suffix, record this file, minus the suffix */
          append(JustNameCharList, DotExtensionCharList, H_InFileCharList),
          name(JustNameAtom, JustNameCharList),
          H_OutFileAtom=JustNameAtom,
          filesWithExtension(T_InFileAtomList,
                             DotExtensionCharList,
                             T_OutFileAtomList).

filesWithExtension([_ | T_InFileAtomList],
                   DotExtensionCharList,
                   OutFileAtomList) :-
          filesWithExtension(T_InFileAtomList,
                             DotExtensionCharList,
                             OutFileAtomList).



/************************************************************************/
/* For a run-time system build of the checker, the environment variable */
/* SPADE_CHECKER may be used to override the default.  The default is   */
/* $SP_APP_DIR/../lib/checker/rules/ where $SP_APP_DIR is set by SICSTUS*/
/* to be the directory in which the checker binary is located - the     */
/* normal place for rules to be located in a customer installation.     */
/*                                                                      */
/* Help files are similarly located, but may be overridden by a user    */
/* setting SPADE_CHKHELP                                                */
/*                                                                      */
/* This policy mimics the behaviour of the wrapper.apb program used     */
/* with POPLOG-built checkers.                                          */
/************************************************************************/
fetch_environment_variables :-
        current_prolog_flag(system_type, runtime),
        !,
        environ('SP_APP_DIR', CHECKER_ROOT),
        atom_codes(CHECKER_ROOT, CR),
        (
           environ('SPADE_CHECKER', RULES_PATH),
           atom_codes(RULES_PATH, RULES_PATH_STR),
           append(RULES_PATH_STR, "/", RULES_PATH_STR2),
           assertz(spade_checker_prefix(RULES_PATH_STR2))
        ;
           \+ environ('SPADE_CHECKER', _Y),
           append(CR, "/../lib/checker/rules/", RULES_PATH),
           assertz(spade_checker_prefix(RULES_PATH))
        ),
        (
           environ('SPADE_CHKHELP', HELP_PATH),
           atom_codes(HELP_PATH, HELP_PATH_STR),
           append(HELP_PATH_STR, "/", HELP_PATH_STR2),
           assertz(spade_chkhelp_prefix(HELP_PATH_STR2))
        ;
           \+ environ('SPADE_CHKHELP', _Y),
           append(CR, "/../lib/checker/helptext/", HELP_PATH),
           assertz(spade_chkhelp_prefix(HELP_PATH))
        ).



/************************************************************************/
/* For a development build of the checker, the environment variable     */
/* SPADE_CHECKER may be used to override the default.  The default is   */
/* $CWD/../../customer/rules/ where $CWD is the current working         */
/* directory - the normal place for rules to be located relative to the */
/* checker source code.                                                 */
/*                                                                      */
/* Help files are similarly located in $CWD/../../customer/helptext/    */
/* by default but this may also be overridden by setting SPADE_CHKHELP  */
/*                                                                      */
/* This version also reports its action to the standard output for      */
/* convenicence and debugging                                           */
/************************************************************************/
fetch_environment_variables :-
        current_prolog_flag(system_type, development),
        !,
        environ('SP_APP_DIR', CHECKER_ROOT),
        working_directory(CWD, CWD),
        atom_codes(CWD, CR),
        print('!!! This is a SICSTUS Development System'), nl,
        print('!!! SP_APP_DIR is '), print(CHECKER_ROOT), nl,
        print('!!! CWD is '), print(CWD), nl,
        (
           environ('SPADE_CHECKER', RULES_PATH),
           print('!!! Rules in '), print(RULES_PATH), nl,
           atom_codes(RULES_PATH, RULES_PATH_STR),
           append(RULES_PATH_STR, "/", RULES_PATH_STR2),
           assertz(spade_checker_prefix(RULES_PATH_STR2))
        ;
           \+ environ('SPADE_CHECKER', _X),
           append(CR, "/../../customer/rules/", RULES_PATH),
           atom_codes(RP_STR, RULES_PATH),
           print('!!! Rules in '), print(RP_STR), nl,
           assertz(spade_checker_prefix(RULES_PATH))
        ),
        (
           environ('SPADE_CHKHELP', HELP_PATH),
           print('!!! Help  in '), print(HELP_PATH), nl,
           atom_codes(HELP_PATH, HELP_PATH_STR),
           append(HELP_PATH_STR, "/", HELP_PATH_STR2),
           assertz(spade_chkhelp_prefix(HELP_PATH_STR2))
        ;
           \+ environ('SPADE_CHKHELP', _Y),
           append(CR, "/../../customer/helptext/", HELP_PATH),
           atom_codes(HP_STR, HELP_PATH),
           print('!!! Help  in '), print(HP_STR), nl,
           assertz(spade_chkhelp_prefix(HELP_PATH))
        ).

printq(X) :-
   write_term(X, [portrayed(true), quoted(true), numbervars(true)]).

/* This duplicates the poplog version of numbervars/3.  The sicstus version unifies */
/* the variables with letters of the alphabet, whereas poplog uses _<number>        */

mynumbervars(Term, N, M) :-
        term_variables(Term, Var),
        format_vars(Var, N, X, M),
        Var=X.

convert(Number, '$VAR2'(Number)):-
        !.

format_vars([], FinalNum, [], FinalNum) :- !.
format_vars([_H|T], Num, [Y|L], FinalNum) :-
        convert(Num, Y),
        Num1 is Num + 1,
        format_vars(T, Num1, L, FinalNum).
%###############################################################################
%END-OF-FILE
