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


/*** UNWRAP(HC,N) -- unwrap quantification around HC(N) ***/
unwrap :-
        (
           command_arg(expression,HC#N)
        ;
           prompt_user('UNWRAP -- Which quantified hypothesis/conclusion?','Type h#N or c#N as appropriate ... '),
           rread(F),
           nonvar(F),
           check_hyp_or_conc(F),
           F=HC#N
        ),
        !,
        clear_up_could_facts,
        !,
        retract(logfact(command, unwrap)),
        asserta(logfact(command, unwrap(HC#N))),
        !,
        unwrap(HC,N),
        !.

unwrap(HORC,N) :-
        nonvar(HORC),
        nonvar(N),
        (
           HORC=h,
           HC=hyp
        ;
           HORC=c,
           HC=conc
        ),
        F=..[HC,N,FORM],
        call(F),
        strip(HC,FORM),
        !.


/*** STRIP(HC,F) -- strip/enter proof frame on formula F if possible ***/
strip(hyp,for_all(X:TYPE,FORMULA)) :-
    make_new_var(qvar,X,TYPE,QVAR),
    subst_vbl(X,QVAR,FORMULA,NEW_FORMULA),
    add_new_hyp(NEW_FORMULA,1),
    !.

strip(conc,for_some(X:TYPE,FORMULA)) :-
    make_new_var(qvar,X,TYPE,QVAR),
    subst_vbl(X,QVAR,FORMULA,NEW_FORMULA),
    start_subgoal(for_some(X:TYPE,FORMULA),[NEW_FORMULA],true,'QUANTIFICATION'),
    !.

strip(hyp,for_some(X:TYPE,FORMULA)) :-
    no_qvars_in(FORMULA),
    make_new_var(uvar,X,TYPE,UVAR),
    subst_vbl(X,UVAR,FORMULA,NEW_FORMULA),
    add_new_hyp(NEW_FORMULA,1),
    !.

strip(conc,for_all(X:TYPE,FORMULA)) :-
    no_qvars_in(FORMULA),
    make_new_var(uvar,X,TYPE,UVAR),
    subst_vbl(X,UVAR,FORMULA,NEW_FORMULA),
    start_subgoal(for_all(X:TYPE,FORMULA),[NEW_FORMULA],true,'QUANTIFICATION'),
    !.


/*** MAKE_NEW_VAR(C,X,T,V) -- make V of class C from X & T ****/
make_new_var(VARCLASS,VAR,TYPE,NEWVAR) :-
    name(VAR,VT),
    (
       VARCLASS=uvar,
       VL=VT
    ;
       make_capital(VT,VL)
    ),
    !,
    name(TYPE,TT),
    (
       length(TT,Len),
       Len=<3,
       TL=TT
    ;
       TT=[T1,T2,T3|_],
       TL=[T1,T2,T3]
    ),
    !,
    append(TL,[95|VL],ROOT),
    repeat,
       nextnumber(ROOT,N),
       codelist(N,NUMBER),
       append(ROOT,[95|NUMBER],NL),
       name(NEWVAR,NL),
    /*until*/ nondeclared(NEWVAR),
    find_core_type(TYPE, CORE_TYPE),
    assertz(var_const(NEWVAR, CORE_TYPE, p)),
    CLASSDEC=..[VARCLASS,NEWVAR],
    assertz(CLASSDEC),
    !.


/*** MAKE_CAPITAL(OLD,NEW) -- convert a list of chars to capitals only ***/
make_capital([],[]) :- !.
make_capital([A|AL],[B|BL]) :-
    (
       A>=97,
       A=<122,
       !,
       B is A-32
    ;
       B=A
    ),
    !,
    make_capital(AL,BL),
    !.


/*** NEXTNUMBER(R,M) -- generate new number for root M ***/
nextnumber(ROOT,M) :-
    (
       retract(current_root(ROOT,N)),
       M is N+1,
       asserta(current_root(ROOT,M))
    ;
       asserta(current_root(ROOT,1)),
       M=1
    ), !.


/*** NONDECLARED(ATOM) -- check ATOM has not been declared already ***/
nondeclared(X) :-
    var_const(X, _, _),
    !,
    fail.
nondeclared(_) :- !.


/*** QVARS_IN(F, Q) -- Q is the list of QVARS in F ***/
qvars_in(FORMULA, QV) :-
        atomic(FORMULA),
        (
           qvar(FORMULA),
           !,
           QV=[FORMULA]
        ;
           QV=[]
        ), !.
qvars_in(FORMULA, QV) :-
        FORMULA=..[_OP|ARGS],
        qvars_in_list(ARGS, QV),
        !.

/*** QVARS_IN_LIST(LIST, QVLIST) -- QVLIST is the list of QVARS in LIST ***/
qvars_in_list([FORMULA],QV) :-
        qvars_in(FORMULA, QV),
        !.
qvars_in_list([FORMULA|REST],QV) :-
        qvars_in(FORMULA, QF),
        qvars_in_list(REST, QR),
        merge_lists(QF, QR, QV),
        !.


/*** MERGE_LISTS(L1, L2, M) -- merge L1 & L2 to get M ***/
merge_lists([], X, X) :- !.
merge_lists([H|T], X, L) :-
        (
           is_in(H,X),
           !,
           merge_lists(T, X, L)
        ;
           merge_lists(T, X, S),
           L=[H|S]
        ), !.


/*** NO_QVARS_IN(FORMULA) -- guarantee formula free of qvars ***/
no_qvars_in(FORMULA) :-
        qvars_in(FORMULA, []),
        !.


/*** QVARS_IN_VC(QVARS) -- list of qvars in VC ***/
qvars_in_vc(LIST) :-
        findall(Q, qvar(Q), LIST),
        LIST \== [],
        !.


/*** INSTANTIATE -- instantiate a qvar in a formula ***/
instantiate :-
        clear_up_could_facts,
        !,
        (
           command_arg(var, QVAR)
        ;
           qvars_in_vc(QVARS),
           (
              QVARS = [QVAR]
           ;
              QVARS = [],
              !,
              fail
           ;
              prompt_user('Instantiate what? '),
              rread(QVAR),
              nonvar(QVAR)
           )
        ),
        !,
        qvar(QVAR),
        var_const(QVAR, TYPE, p),
        (
           command_arg(value, VALUE)
        ;
           prompt_user('With what? '),
           rread(VAL),
           parse_expression(VAL, VALUE)
        ),
        !,
        novars(VALUE),
        no_qvars_in(VALUE),
        checktype(VALUE,TYPE),
        !,
        put_value(QVAR,VALUE),
        !.


/*** PUT_VALUE(QVAR,VALUE) -- replace QVAR by VALUE in all HCs ***/
put_value(QVAR,VALUE) :-
        (
           HC = hyp
        ;
           HC = deleted_hyp
        ;
           HC = conc
        ),
        F=..[HC,N,FORMULA],
        call(F),
        subst_vbl(QVAR,VALUE,FORMULA,NEW_FORMULA),
        (
           FORMULA \= NEW_FORMULA,
           assertz(inst_form(HC,N,NEW_FORMULA))
        ;
           true
        ),
        fail.
put_value(QVAR,VALUE) :-
        retractall(saved_vc(_, qvar(QVAR))),
        saved_vc(N, FACT),
        subst_vbl(QVAR, VALUE, FACT, NEW_FACT),
        FACT \= NEW_FACT,
        assertz(inst_saved_vc(N, FACT, NEW_FACT)),
        fail.
put_value(_,_) :-
        retract(inst_saved_vc(N, FACT, NEW_FACT)),
        retract(saved_vc(N, FACT)),
        assertz(saved_vc(N, NEW_FACT)),
        fail.
put_value(QVAR,VALUE) :-
        case(CP, N, FACT),
        subst_vbl(QVAR, VALUE, FACT, NEW_FACT),
        FACT \= NEW_FACT,
        assertz(inst_case(CP, N, FACT, NEW_FACT)),
        fail.
put_value(_,_) :-
        retract(inst_case(CP, N, FACT, NEW_FACT)),
        retract(case(CP, N, FACT)),
        assertz(case(CP, N, NEW_FACT)),
        fail.
put_value(QVAR,VALUE) :-
        subgoal_formula(CP, FACT, N, METHOD),
        subst_vbl(QVAR, VALUE, FACT, NEW_FACT),
        FACT \= NEW_FACT,
        assertz(inst_subgoal_formula(CP, FACT, N, METHOD, NEW_FACT)),
        fail.
put_value(_,_) :-
        retract(inst_subgoal_formula(CP, FACT, N, METHOD, NEW_FACT)),
        retract(subgoal_formula(CP, FACT, N, METHOD)),
        assertz(subgoal_formula(CP, NEW_FACT, N, METHOD)),
        fail.
put_value(_, _) :-
        (
           HC = hyp,
           NHC = newhyp,
           OLD = hyp(N, _),
           NEW = hyp(N, FORMULA),
           LOGFACT = NEW,
           MESSAGE = new_hyp_message(N, FORMULA)                /* CFR018 */
        ;
           HC = deleted_hyp,
           NHC = newhyp,
           OLD = deleted_hyp(N, _),
           NEW = deleted_hyp(N, FORMULA),
           LOGFACT = hyp(N, FORMULA),
           MESSAGE = true                                       /* CFR018 */
        ;
           HC = conc,
           NHC = newconc,
           OLD = conc(N, _),
           NEW = conc(N, FORMULA),
           LOGFACT = NEW,
           MESSAGE = new_conc_message(N, FORMULA)               /* CFR018 */
        ),
        retract(inst_form(HC,N,FORMULA)),
        retractall(OLD),
        assertz(NEW),
        assertz(logfact(NHC, LOGFACT)),
        call(MESSAGE),                                          /* CFR018 */
        fail.
put_value(_,_) :-
        retract(inst_saved_vc(N, FACT, NEW_FACT)),
        retract(saved_vc(N, FACT)),
        assertz(saved_vc(N, NEW_FACT)),
        fail.
put_value(QVAR, _) :-
        retractall(qvar(QVAR)),
        retractall(var_const(QVAR, _, _)),
        !.


/*** GENVAR(R,V) -- make variable V with root R ****/
genvar(R,R) :-
        nondeclared(R),
        !.
genvar(R,V) :-
    name(R,ROOT),
    repeat,
       nextnumber(ROOT,N),
       codelist(N,NUMBER),
       append(ROOT,NUMBER,VAR),
       name(V,VAR),
    /*until*/ nondeclared(V),
    !.
%###############################################################################
%END-OF-FILE
