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


h('The following commands are available at present in the checker:-').
h('').
h('     case            forget            prove         standardise ').
h('     consult         forwardchain      quit          status      ').    /* CFR017 */
h('     declare         help              remember      traverse    ').
h('     deduce          infer             replace       undelete    ').
h('     delete          instantiate       save          unwrap      ').
h('     done            list              set                       ').
h('     execute         newvc             show                      ').
h('     exit            printvc           simplify                  ').
h('').
h('For more specific help on a particular command, type "help COMMAND."').
h('For help on the built-in rules library, type "help rules."').

checkerhelp :-
        command_arg(subject,X),
        !,
        checkerhelp(X),
        !.
checkerhelp :-
        display_general_help,
        !.

display_general_help :- h(L), print(L), nl, fail.
display_general_help :- !.

checkerhelp(X = Y) :-
        get_help_identifier(X, XID),
        get_help_identifier(Y, YID),
        show_help(XID = YID),
        !.
checkerhelp(X) :-
        atomic(X),
        !,
        get_help_identifier(X, XID),
        (
           show_help(XID)
        ;
           show_help(rules = XID)
        ),
        !.

get_help_identifier(OLD_ATOM, NEW_ATOM) :-
        atomic(OLD_ATOM),
        name(OLD_ATOM, OLD_LIST),
        make_letter_list(OLD_LIST, NEW_LIST),
        !,
        find_help_atom(NEW_LIST, NEW_ATOM).


make_letter_list([H|T], [HL|TL]) :-
        make_letter(H, HL),
        !,
        make_letter_list(T, TL),
        !.
make_letter_list([], []) :- !.


make_letter(H, L) :-
        64 < H,
        H < 91,
        H1 is H+32,
        !,
        name(L, [H1]),
        !.
make_letter(H, L) :-
        name(L, [H]),
        !.


find_help_atom(NEW_LIST, NEW_ATOM) :-
        match_command(NEW_LIST, NEW_ATOM).

find_help_atom([a,b|S], abs) :- gen_append(S, _, [s]), !.
find_help_atom([a,p|PEND], append) :- gen_append(PEND, _, [p,e,n,d]), !.
find_help_atom([a,r,i|TH], arith) :- gen_append(TH, _, [t,h]), !.
find_help_atom([a,r,r|AY], array) :- gen_append(AY, _, [a,y]), !.
find_help_atom([a,s|SOC], assoc) :- gen_append(SOC, _, [s,o,c]), !.
find_help_atom([b|ITWISE], bitwise) :- gen_append(ITWISE, _, [i,t,w,i,s,e]), !.
find_help_atom([c|OMMUT], commut) :- gen_append(OMMUT, _, [o,m,m,u,t]), !.
find_help_atom([d|ISTRIB], distrib) :- gen_append(ISTRIB, _, [i,s,t,r,i,b]), !.
find_help_atom([e,n|UM], enum) :- gen_append(UM, _, [u,m]), !.
find_help_atom([e,n,u,m,'_'|CASES], enum_cases) :- gen_append(CASES, _, [c,a,s,e,s]), !.
find_help_atom([e,n,u,m,e|RATION], enumeration) :- gen_append(RATION, _, [r,a,t,i,o,n]), !.
find_help_atom([e,q], eq) :- !.
find_help_atom([e,q,u|IV], equiv) :- gen_append(IV, _, [i,v]), !.
find_help_atom([e,q,u,i,v,a|LENCE], equivalence) :- gen_append(LENCE, _, [l,e,n,c,e]), !.
find_help_atom([e,x,p], exp) :- !.                              /* CFR042 */
find_help_atom([f|IRST], first) :- gen_append(IRST, _, [i,r,s,t]), !.
find_help_atom([i,m|PLIES], implies) :- gen_append(PLIES, _, [p,l,i,e,s]), !.
find_help_atom([i,n,e|QUALS], inequals) :- gen_append(QUALS, _, [q,u,a,l,s]), !.
find_help_atom([i,n,f|ERENCE], inference) :- gen_append(ERENCE, _, [e,r,e,n,c,e]), !.
find_help_atom([i,n,t|DIV], intdiv) :- gen_append(DIV, _, [d,i,v]), !.
find_help_atom([l,a|ST], last) :- gen_append(ST, _, [s,t]), !.
find_help_atom([l,o,g,i,c], logic) :- !.
find_help_atom([l,o,g,i,c,a,l], logical) :- !.
find_help_atom([l,o,g,i,c,a,l,'_',n|OT], logical_not) :- gen_append(OT, _, [o,t]), !.
find_help_atom([l,o,g,i,c,a,l,'_',a|ND], logical_and) :- gen_append(ND, _, [n,d]), !.
find_help_atom([l,o,g,i,c,a,l,'_',o|R], logical_or) :- gen_append(R, _, [r]), !.
find_help_atom([m,i|NUS], minus) :- gen_append(NUS, _, [n,u,s]), !.  /*CFR043*/
find_help_atom([m,k,'_','_',a|RRAY], mk__array) :-              /* CFR043 */
        gen_append(RRAY, _, [r,r,a,y]), !.                      /* CFR043 */
find_help_atom([m,k,'_','_',r|ECORD], mk__record) :-            /* CFR043 */
        gen_append(ECORD, _, [e,c,o,r,d]), !.                   /* CFR043 */
find_help_atom([m,o|DULAR], modular) :- gen_append(DULAR, _, [d,u,l,a,r]), !.
find_help_atom([n,e|GATION], negation) :- gen_append(GATION, _, [g,a,t,i,o,n]), !.
find_help_atom([n,o,n,f|IRST], nonfirst) :- gen_append(IRST, _, [i,r,s,t]), !.
find_help_atom([n,o,n,l|AST], nonlast) :- gen_append(AST, _, [a,s,t]), !.
find_help_atom([o|DD], odd) :- gen_append(DD, _, [d,d]), !.
find_help_atom([q|UANT], quant) :- gen_append(UANT, _, [u,a,n,t]), !.
find_help_atom([r,e,c|ORD], record) :- gen_append(ORD, _, [o,r,d]), !.
find_help_atom([r,e,c,o,r,d,'_'|EQUALITY], record_equality) :- gen_append(EQUALITY, _, [e,q,u,a,l,i,t,y]), !.
find_help_atom([r,u|LES], rules) :- gen_append(LES, _, [l,e,s]), !.
find_help_atom([s,e,q], seq) :- !.
find_help_atom([s,e,q,l|EN], seqlen) :- gen_append(EN, _, [e,n]), !.
find_help_atom([s,e,t|S], sets) :- gen_append(S, _, [s]), !.
find_help_atom([s,q|R], sqr) :- gen_append(R, _, [r]), !.
find_help_atom([s,t,a|NDARDISATION], standardisation) :- gen_append(NDARDISATION, _, [n,d,a,r,d,i,s,a,t,i,o,n]), !.
find_help_atom([s,t,r|ENGTHEN], strengthen) :- gen_append(ENGTHEN, _, [e,n,g,t,h,e,n]), !.
find_help_atom([t,r,a|NSITIVITY], transitivity) :- gen_append(NSITIVITY, _, [n,s,i,t,i,v,i,t,y]), !.
find_help_atom([u,n,i|FICATION], unification) :- gen_append(FICATION, _, [f,i,c,a,t,i,o,n]), !.
find_help_atom([z|ERO], zero) :- gen_append(ERO, _, [e,r,o]), !.


show_help(PATTERN) :-
        helpfilename(PATTERN, FILELIST),                        /* CFR048 */
        spade_chkhelp_prefix(SPADE_CHKHELP),                    /* CFR048 */
        append(SPADE_CHKHELP, FILELIST, NAMELIST),              /* CFR048 */
        name(FILENAME, NAMELIST),                               /* CFR048 */
        (
           open_help_file(FILENAME),
           show_help_for(PATTERN),
           seen,
           see_correct_input_stream                             /* CFR015 */
        ;
           write('ERROR: Cannot open or display Checker help library file -- '),
           print(FILENAME),
           nl
        ),
        !.

open_help_file(FILENAME) :-
        file_exists_and_is_readable(FILENAME),
        see(FILENAME),
        seen,
        see(FILENAME),
        !.

show_help_for(PATTERN) :-
        repeat,
           read_term_and_layout(X),
        /* until */ found_help_pattern(PATTERN, X),
        !,
        read_help_lines(X, Y),
        !,
        display_help_lines(Y, 20),
        !.


found_help_pattern(PATTERN, [PATTERN]) :- !.
found_help_pattern(_PATTERN, end_of_file) :- !.


read_help_lines(end_of_file, []) :- !.
read_help_lines(P, LIST) :-
        read_term_and_layout(X),
        (
           X=[_|_],
           LIST = []
        ;
           X=end_of_file,
           LIST = []
        ;
           LIST=[X|REST],
           !,
           read_help_lines(P, REST)
        ),
        !.


display_help_lines([], _) :- !.
display_help_lines([X|Y], N) :-
        N>0,
        print(X), nl,
        N1 is N-1,
        !,
        display_help_lines(Y, N1),
        !.
display_help_lines(X, 0) :-
        nl, nl,
        is_inverse_video(I), print(I),
        write('MORE'),
        is_normal_video(N), print(N),
        write(' (Press Return)...'),
        see_correct_input_stream,                               /* CFR015 */
        eol_char(EOL),
        lskip(EOL),                                             /* CFR014 */
        !,
        display_help_lines(X, 20),
        !.


/*** HELPFILES -- Commands ***/
helpfilename( case,                     "case.chl"      ).      /* CFR048 */
helpfilename( consult,                  "consult.chl"   ).      /* CFR048 */
helpfilename( declare,                  "declare.chl"   ).      /* CFR048 */
helpfilename( deduce,                   "deduce.chl"    ).      /* CFR048 */
helpfilename( delete,                   "delete.chl"    ).      /* CFR048 */
helpfilename( done,                     "done.chl"      ).      /* CFR048 */
helpfilename( exit,                     "exit.chl"      ).      /* CFR048 */
helpfilename( execute,                  "execute.chl"   ).  /* CFR017,048 */
helpfilename( forget,                   "forget.chl"    ).      /* CFR048 */
helpfilename( forwardchain,             "forwardch.chl" ).      /* CFR048 */
helpfilename( 'help',                   "help.chl"      ).      /* CFR048 */
helpfilename( infer,                    "infer.chl"     ).      /* CFR048 */
helpfilename( instantiate,              "instantia.chl" ).      /* CFR048 */
helpfilename( list,                     "list.chl"      ).      /* CFR048 */
helpfilename( newvc,                    "newvc.chl"     ).      /* CFR048 */
helpfilename( printvc,                  "printvc.chl"   ).      /* CFR048 */
helpfilename( prove,                    "prove.chl"     ).      /* CFR048 */
helpfilename( quit,                     "quit.chl"      ).      /* CFR048 */
helpfilename( remember,                 "remember.chl"  ).      /* CFR048 */
helpfilename( replace,                  "replace.chl"   ).      /* CFR048 */
helpfilename( save_state,               "save.chl"      ).      /* CFR048 */
helpfilename( (set),                    "set.chl"       ).      /* CFR048 */
helpfilename( show,                     "show.chl"      ).      /* CFR048 */
helpfilename( simplify,                 "simplify.chl"  ).      /* CFR048 */
helpfilename( standardise,              "standard.chl"  ).      /* CFR048 */
helpfilename( status,                   "status.chl"    ).      /* CFR048 */
helpfilename( traverse,                 "traverse.chl"  ).      /* CFR048 */
helpfilename( undelete,                 "undelete.chl"  ).      /* CFR048 */
helpfilename( unwrap,                   "unwrap.chl"    ).      /* CFR048 */


/*** HELPFILES -- built-in rule libraries ***/
helpfilename( rules,                    "rules.chl"     ).      /* CFR048 */

helpfilename( rules = arith,            "rxarith.chl"   ).      /* CFR048 */
helpfilename( rules = assoc,            "rxarith.chl"   ).      /* CFR048 */

helpfilename( rules = bitwise,      "rxmodular.chl" ).

helpfilename( rules = commut,           "rxarith.chl"   ).      /* CFR048 */
helpfilename( rules = distrib,          "rxarith.chl"   ).      /* CFR048 */
helpfilename( rules = minus,            "rxarith.chl"   ).      /* CFR048 */
helpfilename( rules = intdiv,           "rxarith.chl"   ).      /* CFR048 */

helpfilename( rules = array,            "rxarray.chl"   ).      /* CFR048 */
helpfilename( rules = mk__array,        "rxarray.chl"   ).  /* CFR043,048 */

helpfilename( rules = enum,             "rxenum.chl"    ).      /* CFR048 */
helpfilename( rules = enum_cases,       "rxenum.chl"    ).      /* CFR048 */
helpfilename( rules = enumeration,      "rxenum.chl"    ).      /* CFR 1054 */

helpfilename( rules = abs,              "rxfdlfunc.chl" ).      /* CFR048 */
helpfilename( rules = sqr,              "rxfdlfunc.chl" ).      /* CFR048 */
helpfilename( rules = odd,              "rxfdlfunc.chl" ).      /* CFR048 */
helpfilename( rules = exp,              "rxfdlfunc.chl" ).  /* CFR042,048 */

helpfilename( rules = transitivity,     "rxgenineq.chl" ).      /* CFR048 */
helpfilename( rules = strengthen,       "rxgenineq.chl" ).      /* CFR048 */
helpfilename( rules = negation,         "rxgenineq.chl" ).      /* CFR048 */

helpfilename( rules = inequals,         "rxinequal.chl" ).      /* CFR048 */
helpfilename( rules = zero,             "rxinequal.chl" ).      /* CFR048 */

helpfilename( rules = logical_not,      "rxlogic.chl"   ).      /* CFR048 */
helpfilename( rules = logical_and,      "rxlogic.chl"   ).      /* CFR048 */
helpfilename( rules = logical_or,       "rxlogic.chl"   ).      /* CFR048 */
helpfilename( rules = implies,          "rxlogic.chl"   ).      /* CFR048 */
helpfilename( rules = equivalence,      "rxlogic.chl"   ).      /* CFR048 */
helpfilename( rules = logical,          "rxlogic.chl"   ).      /* CFR048 */

helpfilename( rules = modular,      "rxmodular.chl" ).

helpfilename( rules = quant,            "rxquantif.chl" ).      /* CFR048 */

helpfilename( rules = record,           "rxrecord.chl"  ).      /* CFR048 */
helpfilename( rules = record_equality,  "rxrecord.chl"  ).      /* CFR048 */
helpfilename( rules = mk__record,       "rxrecord.chl"  ).  /* CFR043,048 */

helpfilename( rules = seqlen,           "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = append,           "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = first,            "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = last,             "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = nonfirst,         "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = nonlast,          "rxseq.chl"     ).      /* CFR048 */
helpfilename( rules = seq,              "rxseq.chl"     ).      /* CFR048 */

helpfilename( rules = sets,             "rxsets.chl"    ).      /* CFR048 */

helpfilename( rules = inference,        "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = eq,               "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = equiv,            "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = simplify,         "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = logic,            "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = standardisation,  "rxspecial.chl" ).      /* CFR048 */
helpfilename( rules = unification,      "rxspecial.chl" ).      /* CFR048 */
%###############################################################################
%END-OF-FILE
