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


record_simplify(OLD, NEW) :-
        (
           record_function(N,OLD,update,F,[REC,VAL],T),         /* CFR029 */
           (
              record_function(_,VAL,access,F,[REC],T),          /* CFR029 */
              simplify(REC, NEW)
           ;
              order_updates(OLD, NEW)
           )
        ;

           record_function(_,OLD,access,F,[RECORD],_),          /* OLD is a fld_xxx(RECORD) */
           !,                                                   /* so commit to this branch */
           checktype(RECORD, T),                                /* find the record type, */
           record_function(N,OLD,access,F,[RECORD],T),          /* find the N for type T */
           record_access(N, T, RECORD, NEW)                     /* and call record_access */

        ), !.


order_updates(OLD, NEW) :-
        checktype(OLD, TYPE),                                   /* CFR029 */
        make_update_list(OLD, TYPE, OLDLIST, CORE),             /* CFR029 */
        keysort(OLDLIST, NEWLIST),
        reconstruct_record(NEW, TYPE, NEWLIST, CORE),           /* CFR029 */
        !.


make_update_list(OLD, TYPE, LIST, CORE) :-                      /* CFR029 */
        record_function(N,OLD,update,_F,[RECORD,VALUE],TYPE),   /* CFR029 */
        !,
        make_update_list(RECORD, TYPE, SO_FAR, CORE),           /* CFR029 */
        !,
        (
           is_in((N-_),SO_FAR),
           !,
           append(FRONT, [(N-_)|TAIL], SO_FAR),
           append(FRONT, [(N-VALUE)|TAIL], LIST)
        ;
           LIST=[(N-VALUE)|SO_FAR]
        ),
        !.
make_update_list(CORE, _, [], CORE) :- !.                       /* CFR029 */


reconstruct_record(NEW, TYPE, [(N-V)|REST], CORE) :-            /* CFR029 */
        reconstruct_record(SO_FAR, TYPE, REST, CORE),           /* CFR029 */
        !,
        simplify(V, VALUE),
        record_function(N,NEW,update,_F,[SO_FAR,VALUE],TYPE),   /* CFR029 */
        !.
reconstruct_record(CORE, _, [], CORE) :- !.                     /* CFR029 */


record_access(N, T, RECORD, VALUE) :-                           /* CFR029 */
        record_function(M,RECORD,update,_F,[R,V],T),            /* CFR029 */
        !,
        (
           M=N,
           !,
           simplify(V,VALUE)
        ;
           record_access(N, T, R, VALUE)                        /* CFR029 */
        ),
        !.
record_access(N, T, RECORD, VALUE) :-                           /* CFR036 */
        \+ atomic(RECORD),                                      /* CFR036 */
        RECORD =.. [mk__record|COMPONENTS],                     /* CFR036 */
        spark_enabled,                                          /* CFR036 */
        !,                                                      /* CFR036 */
        record_function(N, _, access, FIELD, _, T),             /* CFR036 */
        is_in(FIELD := V, COMPONENTS),                          /* CFR036 */
        simplify(V, VALUE),                                     /* CFR036 */
        !.                                                      /* CFR036 */
record_access(N, T, RECORD, VALUE) :-
        \+ atomic(RECORD),
        RECORD =.. [F|COMPONENTS],
        mk__function_name(F, T, record),
        spark_enabled,
        !,
        record_function(N, _, access, FIELD, _, T),
        is_in(FIELD := V, COMPONENTS),
        simplify(V, VALUE),
        !.
record_access(N, T, RECORD, VALUE) :-                           /* CFR029 */
        (
           record_simp_of_type(T, RECORD, NEWREC) /* CFR 1234 - Don't chuck away type */
        ;
           NEWREC=RECORD
        ),
        !,
        record_function(N,VALUE,access,_F,[NEWREC],T),          /* CFR029 */
        !.

/* CFR 1224 introduces record_simp_of_type to improve performance */
record_simp_of_type(T, OLD, NEW) :-
        (
           record_function(N, OLD, update, F, [REC,VAL], T),
           (
              record_function(_, VAL, access, F, [REC], T),
              simplify(REC, NEW)
           ;
              order_updates(OLD, NEW)
           )
        ;
           record_function(_, OLD, access, F, [RECORD], _),
           !,
           checktype(RECORD, T2),
           record_function(N, OLD, access, F, [RECORD], T2),
           record_access(N, T2, RECORD, NEW)
        ), !.

array_simplify(update(A,I,X), NEW) :-
        !,
        remove_update_duplicates(update(A,I,X), SO_FAR),
        !,
        do_array_simplify(SO_FAR, NEW),
        !.
array_simplify(element(A,I), NEW) :-
        !,
        do_array_simplify(element(A,I), NEW),
        !.


do_array_simplify(update(A, I, X), NEW) :-
        do_array_simplify(A, NEWA),
        simplify(X, NEWX),
        eval_list(I, NEWI),
        !,
        (
           (
              NEWX=element(A, J)
           ;
              A\=NEWA,
              NEWX=element(NEWA, J)
           ;
              X\=NEWX,
              (
                 X=element(A, J)
              ;
                 A\=NEWA,
                 X=element(NEWA, J)
              )
           ),
           (
              infer(NEWI=J)
           ;
              I\=NEWI,
              infer(I=J)
           ),
           !,
           NEW=NEWA
        ;
           NEWA=update(AA, J, _Y),
           (
              infer(NEWI=J)
           ;
              I\=NEWI,
              infer(I=J)
           ),
           !,
           NEW=update(AA, NEWI, NEWX)
        ;
           NEW=update(NEWA, NEWI, NEWX)
        ), !.
do_array_simplify(element(A, I), NEW) :-
        do_array_simplify(A, NEWA),
        eval_list(I, NEWI),
        find_element(NEWA, NEWI, NEW),
        !.
do_array_simplify(X,Y) :-
        !,
        simplify(X,Y),
        !.

find_element(update(A, I, _X), J, E) :-
        infer(I<>J),
        !,
        find_element(A, J, E),
        !.
find_element(update(_A, I, X), J, X) :-
        infer(I=J),
        !.
find_element(A, [J], X) :-                                      /* CFR036 */
        \+ atomic(A),                                           /* CFR036 */
        A =.. [mk__array|COMPONENTS],                           /* CFR036 */
        spark_enabled,                                          /* CFR036 */
        reverse(COMPONENTS, REV_COMPS),                         /* CFR036 */
        find_array_component(REV_COMPS, J, X).                  /* CFR036 */
find_element(A, [J], X) :-
        \+ atomic(A),
        A =.. [F|COMPONENTS],
        mk__function_name(F, _, array),
        spark_enabled,
        reverse(COMPONENTS, REV_COMPS),
        find_array_component(REV_COMPS, J, X).
find_element(A, J, element(A, J)) :- !.


remove_update_duplicates(update(A,I,X), update(NEW,I,X)) :-
        remove_updates(A,I,NEWA),
        !,
        remove_update_duplicates(NEWA, NEW),
        !.
remove_update_duplicates(X, X) :- !.


remove_updates(update(A,I,X), J, NEW) :-
        (
           infer(I=J),
           !,
           remove_updates(A, J, NEW)
        ;
           remove_updates(A, J, NEWA),
           NEW=update(NEWA, I, X)
        ),
        !.
remove_updates(X, _, X) :- !.


find_array_component([H := V|T], J, X) :-                       /* CFR036 */
        (                                                       /* CFR036 */
           satisfies_index_constraint(H, J),                    /* CFR036 */
           !,                                                   /* CFR036 */
           simplify(V, X)                                       /* CFR036 */
        ;                                                       /* CFR036 */
           does_not_satisfy_index_constraint(H, J),             /* CFR036 */
           !,                                                   /* CFR036 */
           find_array_component(T, J, X)                        /* CFR036 */
        ),                                                      /* CFR036 */
        !.                                                      /* CFR036 */
find_array_component([V], _J, X) :-                             /* CFR036 */
        V \= (_ := _),                                          /* CFR049 */
        simplify(V, X),                                         /* CFR036 */
        checktype(X, _),                                        /* CFR036 */
        !.                                                      /* CFR036 */


satisfies_index_constraint(I1 & I2, J) :-                       /* CFR036 */
        (                                                       /* CFR036 */
           satisfies_index_constraint(I1, J)                    /* CFR036 */
        ;                                                       /* CFR036 */
           satisfies_index_constraint(I2, J)                    /* CFR036 */
        ),                                                      /* CFR036 */
        !.                                                      /* CFR036 */
satisfies_index_constraint([I1 .. I2], J) :-                    /* CFR036 */
        infer(I1 <= J),                                         /* CFR036 */
        infer(J <= I2),                                         /* CFR036 */
        !.                                                      /* CFR036 */
satisfies_index_constraint([I], J) :-                           /* CFR036 */
        infer(I=J),                                             /* CFR036 */
        !.                                                      /* CFR036 */

does_not_satisfy_index_constraint(I1 & I2, J) :-                /* CFR036 */
        does_not_satisfy_index_constraint(I1, J),               /* CFR036 */
        does_not_satisfy_index_constraint(I2, J),               /* CFR036 */
        !.                                                      /* CFR036 */
does_not_satisfy_index_constraint([I1 .. I2], J) :-             /* CFR036 */
        !,                                                      /* CFR036 */
        (                                                       /* CFR036 */
          infer(J < I1)                                         /* CFR036 */
        ;                                                       /* CFR036 */
          infer(J > I2)                                         /* CFR036 */
        ),                                                      /* CFR036 */
        !.                                                      /* CFR036 */
does_not_satisfy_index_constraint([I], J) :-                    /* CFR036 */
        infer(I <> J),                                          /* CFR036 */
        !.                                                      /* CFR036 */


set_simplify(A \/ B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWA=NEWB,
           !,
           NEW=NEWA
        ;
           NEWA = (set ASET),
           NEWB = (set BSET),
           append(ASET, BSET, USET),
           simp_set_list(USET, U),
           sort(U, UNION),
           NEW = (set UNION)
        ;
           do_infer(NEWA subset_of NEWB),
           !,
           NEW=NEWB
        ;
           do_infer(NEWB subset_of NEWA),
           !,
           NEW=NEWA
        ;
           NEW = (NEWA \/ NEWB)
        ), !.
set_simplify(A /\ B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWA=NEWB,
           !,
           NEW=NEWA
        ;
           NEWA = (set ASET),
           NEWB = (set BSET),
           make_intersection(ASET, BSET, NEW)
        ;
           do_infer(NEWA subset_of NEWB),
           !,
           NEW=NEWA
        ;
           do_infer(NEWB subset_of NEWA),
           !,
           NEW=NEWB
        ;
           NEW = (NEWA /\ NEWB)
        ), !.
set_simplify(A \ B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWA=NEWB,
           !,
           NEW=(set [])
        ;
           NEWB=(set []),
           NEW=NEWA
        ;
           NEWA = (set ASET),
           NEWB = (set BSET),
           make_difference(ASET, BSET, NEW)
        ;
           do_infer(NEWA subset_of NEWB),
           !,
           NEW=(set [])
        ;
           NEW = (NEWA \ NEWB)
        ), !.

set_simplify(A subset_of B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           (
              NEWA=NEWB
           ;
              NEWA=(set [])
           ;
              NEWB = (B1 \/ B2),
              (
                 set_simplify(NEWA subset_of B1, true)
              ;
                 set_simplify(NEWA subset_of B2, true)
              )
           ;
              NEWA = (A1 \ A2),
              set_simplify(A1 subset_of NEWB, true)
           ;
              NEWA = (A1 /\ A2),
              (
                 set_simplify(A1 subset_of NEWB, true)
              ;
                 set_simplify(A2 subset_of NEWB, true)
              )
           ;
              NEWA = (set ASET),
              NEWB = (set BSET),
              is_subset_of(ASET, BSET)
           ),
           NEW=true
        ;
           NEW = (NEWA subset_of NEWB)
        ), !.
set_simplify(A strict_subset_of B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWA=(set ASET),
           NEWB=(set BSET),
           is_strict_subset_of(ASET, BSET),
           NEW=true
        ;
           NEW = (NEWA strict_subset_of NEWB)
        ), !.
set_simplify(A in B, NEW) :-
        simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWB=(set _),
           (
              do_infer(NEWA in NEWB),
              NEW=true
           ;
              do_infer(NEWA not_in NEWB),
              NEW=false
           )
        ;
           NEW = (NEWA in NEWB)
        ), !.
set_simplify(A not_in B, NEW) :-
        simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWB=(set _),
           (
              do_infer(NEWA not_in NEWB),
              NEW=true
           ;
              do_infer(NEWA in NEWB),
              NEW=false
           )
        ;
           NEW = (NEWA not_in NEWB)
        ), !.
set_simplify(A=B, NEW) :-
        set_simplify(A, NEWA),
        set_simplify(B, NEWB),
        (
           NEWA=NEWB,
           NEW=true
        ;
           NEW=(NEWA=NEWB)
        ), !.
set_simplify(A<>B, NEW) :-
        set_simplify(A=B, EQ),
        (
           EQ=true,
           NEW=false
        ;
           EQ=(A1=B1),
           NEW=(A1<>B1)
        ;
           NEW=(not EQ)
        ), !.

set_simplify((set L), (set M)) :-
        simp_set_list(L, N),
        sort(N, M),
        !.
set_simplify(SOMETHING, ELSE) :-
        (
           atom(SOMETHING),
           ELSE=SOMETHING
        ;
           SOMETHING =.. [F|SARGS],
           eval_list(SARGS, EARGS),
           ELSE =.. [F|EARGS]
        ), !.

simp_set_list([H|T], LIST) :-
        simp_set_list(T, TAIL),
        simplify(H, NEWH),
        (
           in_set_list(NEWH, TAIL),
           LIST=TAIL
        ;
           LIST=[NEWH|TAIL]
        ), !.
simp_set_list([], []) :- !.


in_set_list(E, [H|_T]) :-
        infer(E=H),
        !.
in_set_list(E, [_|T]) :-
        in_set_list(E, T),
        !.

not_in_set_list(_E, []) :- !.
not_in_set_list(E, [H|T]) :-
        infer(E<>H),
        not_in_set_list(E, T),
        !.

make_intersection([_H|_T], [], (set [])).
make_intersection([], [_H|_T], (set [])).
make_intersection(S1, S2, (set S)) :-
        mk_intersect(S1, S2, SET),
        sort(SET, S),
        !.

mk_intersect([], _L, []) :- !.
mk_intersect([H|T], L, S) :-
        mk_intersect(T, L, I),
        (
           in_set_list(H, L),
           (
              not_in_set_list(H, I),
              S=[H|I]
           ;
              in_set_list(H, I),
              S=I
           ;
              S=[H|I]
           )
        ;
           not_in_set_list(H, L),
           S=I
        ), !.

make_difference([], _, (set [])) :- !.
make_difference(L, [], (set L)) :- !.
make_difference(A, B, (set S)) :-
        mk_diff(A, B, SET),
        sort(SET, S),
        !.

mk_diff([], _, []) :- !.
mk_diff([H|T], L, S) :-
        mk_diff(T, L, D),
        (
           in_set_list(H, L),
           S=D
        ;
           not_in_set_list(H, L),
           S=[H|D]
        ), !.

is_subset_of([], _) :- !.
is_subset_of([H|T], L) :-
        in_set_list(H, L),
        is_subset_of(T, L),
        !.

is_strict_subset_of(A, B) :-
        is_subset_of(A, B),
        mk_diff(B, A, S),
        S=[_|_],
        !.


sequence_simplify(L1 @ L2, LIST) :-
        (                                                       /* CFR050 */
           sequence_simplify(L1, LL1)                           /* CFR050 */
        ;                                                       /* CFR050 */
           simplify(L1, LL1)                                    /* CFR050 */
        ),                                                      /* CFR050 */
        (                                                       /* CFR050 */
           sequence_simplify(L2, LL2)                           /* CFR050 */
        ;                                                       /* CFR050 */
           simplify(L2, LL2)                                    /* CFR050 */
        ),                                                      /* CFR050 */
        !,                                                      /* CFR050 */
        (                                                       /* CFR050 */
           LL1 = [],                                            /* CFR050 */
           LIST = LL2                                           /* CFR050 */
        ;                                                       /* CFR050 */
           LL2 = [],                                            /* CFR050 */
           LIST = LL1                                           /* CFR050 */
        ;                                                       /* CFR050 */
           LL1 = [_|_],                                         /* CFR050 */
           LL2 = [_|_],                                         /* CFR050 */
           append(LL1, LL2, LIST)                               /* CFR050 */
        ;                                                       /* CFR050 */
           LIST = (LL1 @ LL2)                                   /* CFR050 */
        ),                                                      /* CFR050 */
        !.                                                      /* CFR050 */
sequence_simplify(first(SEQ), NEW) :-
        sequence_simplify(SEQ, NEWSEQ),
        (
           NEWSEQ=[H|_],
           NEW=H
        ;
           NEW=first(NEWSEQ)
        ), !.
sequence_simplify(last(SEQ), NEW) :-
        sequence_simplify(SEQ, NEWSEQ),
        (
           NEWSEQ=[_|_],
           last(NEWSEQ, NEW)
        ;
           NEW=last(NEWSEQ)
        ), !.
sequence_simplify(nonfirst(SEQ), NEW) :-
        sequence_simplify(SEQ, NEWSEQ),
        (
           NEWSEQ=[_|T],
           NEW=T
        ;
           NEW=nonfirst(NEWSEQ)
        ), !.
sequence_simplify(nonlast(SEQ), NEW) :-
        sequence_simplify(SEQ, NEWSEQ),
        (
           NEWSEQ=[_|_],
           append(NEW, [_LAST], NEWSEQ)
        ;
           NEW=nonlast(NEWSEQ)
        ), !.
sequence_simplify([H|T], NEW) :-
        eval_list([H|T], NEW),
        !.
sequence_simplify([], []) :- !.


enumerated_simplify(succ(X), NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(succ(X), L, NEW),
        !.
enumerated_simplify(pred(X), NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(pred(X), L, NEW),
        !.
enumerated_simplify(X=Y, NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(X, L, NEWX),
        enumerated_simp(Y, L, NEWY),
        (
           NEWX=NEWY,
           !,
           NEW=true
        ;
           is_in(NEWX, L),
           is_in(NEWY, L),
           !,
           NEW=false
        ;
           NEW=(NEWX=NEWY)
        ), !.
enumerated_simplify(X<>Y, NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(X, L, NEWX),
        enumerated_simp(Y, L, NEWY),
        (
           NEWX=NEWY,
           !,
           NEW=false
        ;
           is_in(NEWX, L),
           is_in(NEWY, L),
           !,
           NEW=true
        ;
           NEW=(NEWX<>NEWY)
        ), !.
enumerated_simplify(X<Y, NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(X, L, NEWX),
        enumerated_simp(Y, L, NEWY),
        (
           NEWX=NEWY,
           NEW=false
        ;
           append(BEFORE, [NEWX|AFTER], L),
           (
              is_in(NEWY, AFTER),
              NEW=true
           ;
              is_in(NEWY, BEFORE),
              NEW=false
           )
        ;
           NEW=(NEWX<NEWY)
        ), !.
enumerated_simplify(X>Y, NEW) :-
        enumerated_simplify(Y<X, NEW), !.
enumerated_simplify(X<=Y, NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(X, L, NEWX),
        enumerated_simp(Y, L, NEWY),
        (
           NEWX=NEWY,
           NEW=true
        ;
           append(BEFORE, [NEWX|AFTER], L),
           (
              is_in(NEWY, AFTER),
              NEW=true
           ;
              is_in(NEWY, BEFORE),
              NEW=false
           )
        ;
           NEW=(NEWX<=NEWY)
        ), !.
enumerated_simplify(X>=Y, NEW) :-
        enumerated_simplify(Y<=X, NEW), !.
enumerated_simplify(X, NEW) :-
        checktype(X, T),
        enumeration(T, L),
        enumerated_simp(X, L, NEW),
        !.


enumerated_simp(succ(X), L, NEW) :-
        !,
        enumerated_simp(X, L, NEWX),
        (
           strict_sublist([NEWX,NEW], L)
        ;
           NEWX=pred(NEW),
           L=[H|_],
           infer(NEW<>H)
        ;
           NEW=succ(NEWX)
        ), !.
enumerated_simp(pred(X), L, NEW) :-
        !,
        enumerated_simp(X, L, NEWX),
        (
           strict_sublist([NEW,NEWX], L)
        ;
           NEWX=succ(NEW),
           last(L, H),
           infer(NEW<>H)
        ;
           NEW=pred(NEWX)
        ), !.
enumerated_simp(X, _, NEWX) :-
        simplify(X, NEWX),
        !.
%###############################################################################
%END-OF-FILE
