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

%###############################################################################
% PURPOSE
%-------------------------------------------------------------------------------
% The main export of this module is norm_typed_expr(Old, Type, New) which,
% given a ground expression Old of type Type, is converted into its
% standard form, New.  It works in a number of passes: moving everything to
% one side of a relational operator, multiplying out, collecting together
% like terms, reordering lexicographically, etc.
%###############################################################################

%###############################################################################
% MODULE
%###############################################################################

%###############################################################################
% DEPENDENCIES
%###############################################################################

%###############################################################################
% TYPES
%###############################################################################

%###############################################################################
% DATA
%###############################################################################

%###############################################################################
% PREDICATES
%###############################################################################

%###############################################################################
%     Integer and Boolean Expression Standardisation Module
%###############################################################################

% MAIN PROCEDURE: Normalise an expression of given type
norm_typed_expr(OLD, _TYPE, NEW) :-
        know_norm_expr(OLD, NEW),
        !.
norm_typed_expr(OLD, TYPE, NEW) :-
        do_norm_typed_expr(OLD, TYPE, SO_FAR),
        (
           simplify(SO_FAR, NEW)
        ;
           NEW = SO_FAR
        ),
        save_term_breakdown(NEW, TYPE),
        save_norm_expr(OLD, NEW),
        !.

%-------------------------------------------------------------------------------








do_norm_typed_expr(element(A,I),_T,element(NEWA, NEWI)) :-
        checktype(A, AT),
        !,
        (
           find_core_type(AT, ArrT),
           type(ArrT, array(INDTYPES, _ELEMTYPE)),
           !,
           (
              do_norm_typed_expr(A, ArrT, NEWA)
           ;
              NEWA = A
           ),
           !,
           (
              do_norm_typed_exprs(I, INDTYPES, NEWI)
           ;
              NEWI = I
           )
        ;
           NEWA = A,
           NEWI = I
        ),
        !.

do_norm_typed_expr(update(A, I, X),T,update(NEWA, NEWI, NEWX)) :-
        (
           find_core_type(T, AT),
           type(AT, array(INDTYPES, ELEMTYPE)),
           !,
           (
              do_norm_typed_expr(A, T, NEWA)
           ;
              NEWA = A
           ),
           !,
           (
              do_norm_typed_exprs(I, INDTYPES, NEWI)
           ;
              NEWI = I
           ),
           !,
           (
              do_norm_typed_expr(X, ELEMTYPE, NEWX)
           ;
              NEWX = X
           )
        ;
           NEWA = A,
           NEWI = I,
           NEWX = X
        ),
        !.



do_norm_typed_expr(X,INT,X1) :-
   (
      INT=integer
   ;
      INT=real
   ),
   !,
   apply(X,X1), !.

do_norm_typed_expr(X,boolean,X1) :-
   !,
   do_norm_expr(X,X1),!.

do_norm_typed_expr(E,_,E) :- atomic(E), !.

do_norm_typed_expr(E1,_,E2) :-
   (\+ atomic(E1)),
   E1=..[F|Args1],
   checktypes(Args1,Types),
   do_norm_typed_exprs(Args1,Types,Args2),
   EE=..[F|Args2],
   (
      simplify(EE, E2)
   ;
      E2=EE
   ), !.

%-------------------------------------------------------------------------------

% Deal with list of objects and list of their types.
do_norm_typed_exprs([],[],[]) :- !.

do_norm_typed_exprs([A|A1],[T|T1],[B|B1]) :-
   do_norm_typed_expr(A,T,B),
   do_norm_typed_exprs(A1,T1,B1), !.

%###############################################################################
%                    FUNCTIONS
%                    =========
% DEFINED_FUNCT succeeds if 'Structure' has the same 'Name'
% and 'Arity' as a function defined in the database. The
% corresponding 'Arg_types' and 'Result_type' are noted.
%###############################################################################

defined_funct(Structure,Arg_types,Result_type) :-
   functor(Structure,Name,Arity),
   (
      function(Name,Arg_types,Result_type)
   ;
      built_in(Name,Arg_types,Result_type)
   ),
   length(Arg_types,Arity),
   !.

%-------------------------------------------------------------------------------

% If the arguments of a function are of type 'integer'
% or 'boolean' they may be standardised.
% Note care in filtering errors when reforming function.

simp_funct(X,Arg_types,Y):-
   X=..[Name|Arg_list],
   % simplify arguments.
   simp_args(Arg_list,Arg_types,Args1),
   Y=..[Name|Args1],
   !.

%-------------------------------------------------------------------------------

% SIMP_ARGS(A,L,A1) : A is a list of arguments,
%                     L is a list of types,
%                     A1 becomes a list of simplified arguments

simp_args([X],[Type],[X1]) :-
        is_a_valid_type(Type),
        !,
        norm_typed_expr(X,Type,X1),
        !.

simp_args([X],[_],[X1]) :-
        checktype(X, Type),
        !,
        norm_typed_expr(X,Type,X1),
        !.

simp_args([X|Y],[Type|T],[X1|Y1]) :-
        is_a_valid_type(Type),
        !,
        norm_typed_expr(X,Type,X1),
        !,
        simp_args(Y,T,Y1),
        !.

simp_args([X|Y],[_|T],[X1|Y1]) :-
        checktype(X, Type),
        !,
        norm_typed_expr(X,Type,X1),
        !,
        simp_args(Y,T,Y1),
        !.


%------------------------ END of functions ---------------------------

%###############################################################################
%              ***  S T A N D A R D   F O R M S  ***
%              =====================================
%  Puts arithmetic expressions in standard form.
%###############################################################################





% Integer expression standardisation - main predicates
apply(A,L) :-
   cv(A,B),
   sp(B,C),
   leftint(C,D),
   oneint(D,E),
   createlist(E,F),
   sortlist(F,G),
   busort_prods(G,H),
   compress(H,I),
   nozeros(I,J),
   form_expr(J,K),
   tidy(K,L).

% To produce standard form with first product_term positive
% and sign outside. eg. + or -(a - b + etc.)

standard(A,M) :-
   cv(A,B),
   sp(B,C),
   leftint(C,D),
   oneint(D,E),
   createlist(E,F),
   sortlist(F,G),
   busort_prods(G,H),
   compress(H,I),
   nozeros(I,J),
   form_expr(J,K),
   sign(K,L),
   tidy(L,M).

%-------------------------------------------------------------------------------

% 'Types'





% S_ATOMIC(X) - succeeds if X is an atom or a signed integer
s_atomic(X) :-
   (
      atom(X)
   ;
     (integer(X),
      X>=0)
   ), !.

s_atomic(-X) :- integer(X), X>=0, !.

%-------------------------------------------------------------------------------

% S_INTEGER(X) - succeeds if X is a signed integer
s_integer(X) :- integer(X), X>=0, !.

s_integer(-X) :- integer(X), X>=0, !.

%-------------------------------------------------------------------------------

% TERM(X) - define a 'Term'
term(update(_,_,_)) :- !.
term(element(_,_)) :- !.
term(_X div _Y) :- !.
term(_X / _Y) :- !.
term(_X mod _Y) :- !.
term(_X rem _Y) :- !.
term(odd(_X)) :- !.
term(abs(_X)) :- !.
term(sqr(_X)) :- !.
term(first(_X)) :- !.
term(last(_X)) :- !.
term(nonfirst(_X)) :- !.
term(nonlast(_X)) :- !.
term(length(_X)) :- !.
term(_X @ __Y) :- !.
term(pred(_X)) :- !.
term(last(_X)) :- !.
term(_X \/ _Y) :- !.
term(_X /\ _Y) :- !.
term(_X \ _Y) :- !.
term(_X in _Y) :- !.
term(_X not_in _Y) :- !.
term(_X subset_of _Y) :- !.
term(_X strict_subset_of _Y) :- !.
term(set _X) :- !.
term([_X|_Y]) :- !.
term(X) :- s_atomic(X), !.
term(X) :- record_function(_, X, _, _, _, _), !.
term(X) :- function_template(X, _, _), !.

term(X) :-
        X=..[N|_],
        function(N,_,_), !.

%-------------------------------------------------------------------------------





% PRODUCT(X) - define a 'Product'
product(X*Y) :-
        !,
        product(X),
        product(Y),
        !.

product(X) :- term(X), !.

%-------------------------------------------------------------------------------

% STAGE 1  */
% Multiplies out expression to give sum of products form
% Simplifies all occurrences of X div Y & X mod Y &
% functions.  Also checks for illegal expressions



cv(X,_) :-
   var(X),
   !,
   fail.

cv(X*Y,A) :-
   cv(X,X1),
   cv(Y,Y1),
   multiply_out(X1,Y1,A), !.

cv(X+Y,X1+Y1) :-
   cv(X,X1),
   cv(Y,Y1), !.

cv(X-Y,X1+Y1) :-
   cv(X,X1),
   cv(Y*(-(1)),Y1), !.

cv(X div Y,A) :-
   standard(X,X1),
   standard(Y,Y1),
   simp_num(X1 div Y1,A), !.

cv(X / Y,A) :-
   standard(X,X1),
   standard(Y,Y1),
   simp_num(X1 / Y1,A), !.

cv(X mod Y,A) :-
   standard(X,X1),
   standard(Y,Y1),
   simp_num(X1 mod Y1,A), !.

cv(X rem Y,A) :-
   standard(X,X1),
   standard(Y,Y1),
   simp_num(X1 rem Y1,A), !.

cv(element(A,X),Y) :-
        checktype(element(A,X),T),
        !,
        do_norm_typed_expr(element(A,X),T,Y),
        !.

cv(X,X) :- s_atomic(X), !.

cv(INT,-NEGINT) :- integer(INT), INT<0, NEGINT is -INT, !.

cv(-X,Y) :- cv(X*(-(1)),Y), !.

cv(X,Y) :-
   defined_funct(X,Arg_types,_),
   simp_funct(X,Arg_types,Y),
   !.

cv(X,X).

%-------------------------------------------------------------------------------










% Multiply out two expressions to form a sum of products
% Note the input expressions are in sum of products form
multiply_out(X1+X2,Y1+Y2,A1+A2+A3+A4):-
   multiply_out(X1,Y1,A1),
   multiply_out(X1,Y2,A2),
   multiply_out(X2,Y1,A3),
   multiply_out(X2,Y2,A4),
   !.

multiply_out(X,Y1+Y2,A1+A2) :-
   product(X),
   multiply_out(X,Y1,A1),
   multiply_out(X,Y2,A2),
   !.

multiply_out(X1+X2,Y,A1+A2) :-
   product(Y),
   multiply_out(X1,Y,A1),
   multiply_out(X2,Y,A2),
   !.

multiply_out(X,Y,X*Y) :-
   product(X),
   product(Y),
   !.

%-------------------------------------------------------------------------------

% SIMP_NUM(X div Y,Z) - simplify term if possible; X & Y are in std form
simp_num(X div Y,Z) :-
   s_integer(X),
   s_integer(Y),
   Z iss X div Y, !.

simp_num(_X div 0,_) :-
   !, fail.

simp_num(X div 1,Y):- simp_num(X,Y), !.

simp_num((X div Y) div Z,B) :-
   standard(Y*Z,A),
   simp_num(X div A,B), !.

simp_num((-X) div (-Y),Z) :- simp_num(X div Y,Z), !.

simp_num((-X) div Y,A*(-(1))) :-
   simp_num(X div Y,A), !.

simp_num(X div (-Y),A*(-(1))) :-
   simp_num(X div Y,A), !.

simp_num(X / Y,Z) :-
   s_integer(X),
   s_integer(Y),
   Z iss X / Y, !.

simp_num(_X / 0,_) :-
   !, fail.

simp_num(X / 1,Y):- simp_num(X,Y), !.

simp_num((X / Y) / Z,B) :-
   standard(Y*Z,A),
   simp_num(X / A,B), !.

simp_num((-X) / (-Y),Z) :- simp_num(X / Y,Z), !.

simp_num((-X) / Y,A*(-(1))) :-
   simp_num(X / Y,A), !.

simp_num(X / (-Y),A*(-(1))) :-
   simp_num(X / Y,A), !.

simp_num(X,X) :-
    !.

%-------------------------------------------------------------------------------

% STAGE 2





% SP(OLD,NEW) - remove redundant brackets
sp(X*(Y*Z),A) :-
    sp(X*Y*Z,A), !.

sp(X*Y,Z*Y) :-
   term(Y),
   sp(X,Z), !.

sp(X+(Y+Z),A) :- sp(X+Y+Z,A), !.

sp(X+Y,X1+Y1) :-
   product(Y),
   sp(Y,Y1),
   sp(X,X1), !.

sp(X,X) :- term(X), !.

%-------------------------------------------------------------------------------

% STAGE 3








% LEFTINT(OLD,NEW) - for each product move all integers to the left
leftint(X*Y,A) :-
   s_integer(Y),
   !,
   (
      term(X),
      A=Y*X
   ;
      leftint(X,B),
      sp(Y*B,A)
   ),
   !.





leftint(X*Y,Z*Y) :-
   % implicit: (\+ s_integer(Y))
   leftint(X,Z),
   !.

leftint(X+Y,X1+Y1) :-
   leftint(X,X1),
   leftint(Y,Y1),
    !.

leftint(X,X) :-
    term(X),
    !.

%-------------------------------------------------------------------------------

% STAGE 4

% ONEINT(OLD,NEW) - evaluate integer part of product
oneint(X*Y,A) :-
    s_integer(Y),
    A iss X*Y,
    !.

oneint(X*Nonint,Z*Nonint) :-
    oneint(X,Z),
    !.

oneint(X+Y,X1+Y1) :-
    oneint(X,X1),
    oneint(Y,Y1),
    !.

oneint(X,X) :-
    term(X),
    !.

%-------------------------------------------------------------------------------

% STAGE 5



% CREATELIST(OLD,NEW) - form a list of product terms
createlist(X+Y,[Y|Z]) :-
    createlist(X,Z),
    !.

createlist(X,[X]) :-
    product(X),
    !.

%-------------------------------------------------------------------------------

% STAGE 6





% SORTLIST(OLD,NEW) - for each product, order the list of terms

sortlist([X1|Y1],[X2|Y2]) :-
   sortprod(X1,X2),
   sortlist(Y1,Y2),
    !.

sortlist([],[]) :-
    !.

%-------------------------------------------------------------------------------

% SORTPROD(OLD,NEW) - sort a product term
sortprod(X,Y) :-
   % Put in list form*/
   list_terms(X,Z),
   % Bubble sort the terms*/
   busort_terms(Z,W),
   % Reform product
   list_terms(Y,W),
   !.

%-------------------------------------------------------------------------------

% LIST_TERMS(X,XLIST) - form a list of terms from a product term
list_terms(X*Y,[Y|Z]) :-
    list_terms(X,Z),
    !.

list_terms(X,[X]) :-
    term(X),
    !.

%-------------------------------------------------------------------------------

% BUSORT_TERMS(OLD,NEW) - bubblesort the list of terms
busort_terms(L,S) :-
    gen_append(X,[A,B|Y],L),
    order_terms(B,A),
    gen_append(X,[B,A|Y],M),
    busort_terms(M,S),
    !.

busort_terms(L,L) :-
    !.

%-------------------------------------------------------------------------------

% ORDER_TERMS(OLD,NEW) - succeeds if arguments are in required order
% ORDER 'div' EXPRNS
order_terms(A div B,C div B) :-
    !,
    order_exprs(A,C),
    !.

order_terms(_A div B,_C div D) :-
    !,
    order_exprs(B,D),
    !.

order_terms(_A div _B,_C mod _D) :-
    !.

order_terms(_A div _B,_C rem _D) :-
    !.

% ORDER '/' EXPRNS
order_terms(A / B,C / B) :-
   !,
   order_exprs(A,C),
    !.

order_terms(_A / B,_C / D) :-
   !,
   order_exprs(B,D),
    !.

order_terms(_A / _B,_C mod _D) :-
    !.

order_terms(_A / _B,_C rem _D) :-
    !.

% ORDER rem EXPRNS
order_terms(_A rem _B,_C div _D) :-
   !,
   fail.

% ORDER rem EXPRNS
order_terms(_A rem _B,_C / _D) :-
   !,
   fail.

order_terms(A rem B,C rem B) :-
   !,
   order_exprs(A,C), !.

order_terms(_A rem B,_C rem D) :-
   !,
   order_exprs(B,D), !.

% ORDER mod EXPRNS
order_terms(_A mod _B,_C div _D) :-
   !,
   fail.

% ORDER mod EXPRNS
order_terms(_A mod _B,_C / _D) :-
   !,
   fail.

order_terms(A mod B,C mod B) :-
   !,
   order_exprs(A,C), !.

order_terms(_A mod B,_C mod D) :-
   !,
   order_exprs(B,D), !.

order_terms(A,B) :-
   s_atomic(A),
   !,
   (
      s_atomic(B),
      !,
      less(A,B)
   ;
      true
   ),
   !.

order_terms(_A,B) :-
   % implicit: (\+ s_atomic(A))
   s_atomic(B),
   !,
   fail.

order_terms(A,B) :-
   (
      defined_funct(A,_,_)
   ;
      A = element(_,_)
   ;
      A = update(_,_,_)
   ),
   \+ (
        defined_funct(B,_,_)
      ;
        B = element(_,_)
      ;
        B = update(_,_,_)
   ),
   !.

order_terms(A,B) :-
    !,
    % put functions in list form
    A=..Function1,
    B=..Function2,
    order_functs(Function1,Function2),
    !.

%-------------------------------------------------------------------------------

% less(A,B) succeeds if the s_atomic A is ordered before B
% - integers first, then atoms in alphabetic order -
% Note : if A=B , the predicate fails.

less(Y,X) :-
   s_integer(Y),
   !,
   \+ s_integer(X).
less(_Y,X) :-
   s_integer(X),
   !,
   fail.
less(Y,X) :- Y @< X, !.

%-------------------------------------------------------------------------------

% ORDER_EXPRS(A,B) -  succeeds if expressions A & B are in right order
order_exprs(X,Y) :-
    listexp(X,X1),        % write X as a list of products
    listexp(Y,Y1),        % write Y as a list of products
    orderlist(X1,Y1),     % order by the products in the lists
    !.

%-------------------------------------------------------------------------------

% LISTEXP(E,LP) - write expression E as a list LP of products
listexp(A,I) :-
    cv(A,B),
    sp(B,C),
    leftint(C,D),
    oneint(D,E),
    createlist(E,F),
    sortlist(F,G),
    busort_prods(G,H),
    compress(H,I),
    !.

%-------------------------------------------------------------------------------

% ORDERLIST(A,B) - order expressions by the products in them
orderlist(_,[]) :-
    !,
    fail.

orderlist([],_) :-
    !.

orderlist([H|T1],[H|T2]) :-
    !,
    orderlist(T1,T2),
    !.

orderlist([H1|_T1],[H2|_T2]) :-
    list_terms(H1,L1),           % implicit: H1\=H2
    list_terms(H2,L2),
    !,
    order(L1,L2),
    !.

%-------------------------------------------------------------------------------

% ORDER_FUNCTS - Functions are ordered first by the predicate name
%                then by the arguments. Here the functions are in
%                list form : predicate followed by arguments.

order_functs([Name|Arg_list1],[Name|Arg_list2]) :-
    !,
    orderargs(Arg_list1,Arg_list2),
    !.

order_functs([Name1|_],[Name2|_]) :-
    less(Name1,Name2),
    !.

%-------------------------------------------------------------------------------

% Equal functions are ordered by the arguments they contain.
% Only expressions of type 'integer' can be compared,

orderargs([Arg|A],[Arg|B]) :-
   !,
   orderargs(A,B),
   !.

orderargs([Arg1|_],[Arg2|_]) :-
   checktype(Arg1, integer),
   checktype(Arg2, integer),
   !,
   order_exprs(Arg1,Arg2),
   !.

orderargs([Arg1|_Rest1], [Arg2|_Rest2]) :-
        !,
        Arg1 @< Arg2.

%-------------------------------------------------------------------------------

% STAGE 7

% BUSORT_PRODS(OLD,NEW) - order the list of products itself
busort_prods(L,S) :-
   gen_append(X,[A,B|Y],L),
   order_prods(B,A),
   gen_append(X,[B,A|Y],M),
   busort_prods(M,S),
    !.

busort_prods(L,L) :-
    !.

%-------------------------------------------------------------------------------

% ORDER_PRODS(A,B) - succeeds if product terms A & B are in right order
order_prods(A,B) :-
   essence(A,A1,_),
   list_terms(A1,L1),
   essence(B,B1,_),
   list_terms(B1,L2),
   order(L1,L2),
    !.

%-------------------------------------------------------------------------------

% ORDER(OLD,NEW) - lists of terms are ordered by the terms they contain
order(_,[]) :-
    !,
    fail.

order(_,[[]]) :-
    !,
    fail.

order([],_) :-
    !.

order([[]],_) :-
    !.

order([H|T1],[H|T2]) :-
   !,
   order(T1,T2),
    !.

order([I1|_T1],[I2|_T2]) :-
   s_integer(I1),
   s_integer(I2),
   !,
   I1 < I2.

order([H1|_T1],[H2|_T2]) :-
    order_terms(H1,H2),
    !.

%-------------------------------------------------------------------------------

% STAGE 8

% COMPRESS(OLD,NEW) - add integers together & add similar product terms
compress([X,Y|Z],R) :-
   s_integer(X),
   s_integer(Y),
   T iss X+Y,
   compress([T|Z],R),
    !.

compress([X,Y|Z],R) :-
   essence(X,A,M),
   essence(Y,A,N),
   Sum iss M+N,
   compress([A*Sum|Z],R),
    !.

compress([X,Y|Z],R) :-
   compress([Y|Z],S),
   compress([X],[C]),
   R= [C|S],
   !.

compress([X*1],[X]) :-
    !.

compress([X],[X]) :-
    !.

compress([],[]) :-
    !.

%-------------------------------------------------------------------------------

% ESSENCE(XI,X,I) - gives integer part I & remainder X of expression
essence(X*Y,X,Y) :- s_integer(Y),
    !.

essence(X*Y,X*Y,1) :-
    % implicit: (\+ s_integer(Y))
    term(Y),
    !.

essence(X,[],X) :-
    s_integer(X),
    !.

essence(X,X,1) :-
    % implicit: (\+ s_integer(X))
    term(X),
    !.

%-------------------------------------------------------------------------------

% STAGE 9

% NOZEROS - Remove all zero product terms
%           Note: (a div b)*0 can NOT be removed as b may be zero

nozeros([X*Y*A|T],Z) :-
    zero(A),
    s_atomic(Y),
    nozeros([X*A|T],Z),
    !.

nozeros([X*A|T],Z) :-
    zero(A),
    s_atomic(X),
    nozeros(T,Z),
    !.

nozeros([A|T],Z) :-
    zero(A),
    !,
    nozeros(T,Z),
    !.

nozeros([X|T],[X|Z]) :-
    % implicit: (\+ zero(X))
    nozeros(T,Z),
    !.

nozeros([],[]) :-
    !.

%-------------------------------------------------------------------------------

% ZERO(X) - tests to see if X is zero, i.e. either "0" or "-0"
zero(0).
zero(-(0)).

%-------------------------------------------------------------------------------

% STAGE 10

% FORM_EXPR(L,E) - reform expression E from list L

form_expr([X],Y) :-
    reorder(X,Y),
    !.

form_expr([H|T],X+Y) :-
   reorder(H,X),
   s_integer(X),
   !,
   form_expr(T,Y),
   !.

form_expr([H|T],Z) :-
   reorder(H,X),
   form_expr(T,Y),
   sp1(X+Y,Z),
    !.

form_expr([],0) :- !.

%-------------------------------------------------------------------------------

% REORDER(X,Y) - rewrite product X the right way round to get Y
reorder(X*1,Y) :-
    reorder(X,Y),
    !.

reorder(X*(-Y),-Z) :-
    integer(Y),
    reorder(X*Y,Z),
    !.

reorder(X*Y,Z) :-
    reorder(X,A),
    sp(Y*A,Z),
    !.

reorder(X,X) :-
    term(X),
    !.

%-------------------------------------------------------------------------------

% SP1(X,Y) - use associativity to get rid of brackets in X giving Y
sp1(X+(-Y),X1+(-Y)) :-
    product(Y),
    sp1(X,X1),
    !.

sp1(X+Y,X1+Y) :-
    product(Y),
    sp1(X,X1),
    !.

sp1(X+(Y+Z),A) :-
    sp1(X+Y+Z,A),
    !.

sp1(-X,-X) :-
    product(X).

sp1(X,X) :-
    product(X).

%-------------------------------------------------------------------------------

% SIGN - If the sign of the leftmost product term is minus then
%        change the sign of every product term and enclose the
%        whole expression with the unary minus operator.

sign(X+Y,-(X1+Y1)) :-
   sign(X,-X1),
   changesign(Y,Y1), !.

sign(X+Y,X+Y):- !.

sign(X,X) :- product(X),!.

sign(-X,-X) :- product(X),!.

%-------------------------------------------------------------------------------

% CHANGESIGN(X,MINUSX) - change the sign of X to get MINUSX
changesign(-X,X) :-
    !.
changesign(X,-X) :-
    !.

%-------------------------------------------------------------------------------

% TIDY - converts +(-product_term) to -product_term.

tidy(X+(-Y),Z-Y1) :-
    tidy(X,Z),
    !,
    tidy(Y, Y1),
    !.

tidy(X+Y,Z+Y1) :-
    tidy(X,Z),
    !,
    tidy(Y, Y1),
    !.

tidy(-X,-Y) :-
    tidy(X,Y),
    !.

tidy(X,X) :-
    product(X),
    !.

% ------- END of integer expression standardiser -------------

%###############################################################################
%         STANDARDISE BOOLEAN  EXPRESSIONS
%###############################################################################

% Reduce relational exprs. in boolean exprs. to standard form,
% and simplify exprs. such as 'true or false' to 'true'.
% also rewrite exprs such as
%              'a and (b and c)' to 'a and b and c'.
% Standardise the arguments of quantifiers & boolean functions.

do_norm_expr(E,_):-
    var(E),
    nl,
    write('<<< ERROR: illegal variable >>>'),
    nl,
    !,
    fail.

do_norm_expr(true,true):-
    !.

do_norm_expr(false,false):-
    !.

do_norm_expr(E,E) :-
    % boolean variable
    atomic(E), !.

% Write all integer relational expressions in the form:
%    expr = 0 ; expr <> 0 ; expr > 0.

do_norm_expr(A=B,N) :-
   checktype(A,TYPE),
   (
      TYPE=integer
   ;
      TYPE=real
   ),
   !,                     % just in case
   standard(A-B,E),       % write +;- N[A-B] => E ,
                          % where 1st term of N[A-B] is without -
   simp_rel(E=0,N), !.    % simplify where possible

do_norm_expr(A=B,Z) :-
   checktype(A,T),
   do_norm_typed_expr(A,T,X),
   do_norm_typed_expr(B,T,Y),
   (
     (X=Y,
      Z=true)
   ;
      Z=(X=Y)
   ), !.

do_norm_expr(A<>B,N):-
   checktype(A,TYPE),
   (
      TYPE=integer
   ;
      TYPE=real
   ),
   !,                     % just in case
   standard(A-B,E),       % write in form +;- N[A-B]
                          % where 1st term of N[A-B] is without -
   simp_rel(E<>0,N), !.   % simplify where possible

do_norm_expr(A<>B,Z) :-
   checktype(A,T),
   do_norm_typed_expr(A,T,X),
   do_norm_typed_expr(B,T,Y),
   (
     (X=Y,
      Z=false)
   ;
      Z=(X<>Y)
   ), !.

do_norm_expr(A>=B,N):-
   checktype(A,integer),
   checktype(B,integer),
   !,
   apply(A-B+1,E),            % write N[A-B+1] as E
   simp_rel(E>0,N), !.        % and simplify E>0.

do_norm_expr(A>=B,N) :- do_norm_expr(B<=A,N), !.

do_norm_expr(A<=B,N):-
   checktype(A,integer),
   checktype(B,integer),
   !,
   apply(B-A+1,E),            % write N[B-A+1] as E
   simp_rel(E>0,N), !.        % and simplify E>0.

do_norm_expr(A<=B,N):-
   checktype(A,real),
   checktype(B,real),
   !,
   apply(B-A,E),               % write N[A-B+1] as E
   simp_rel(E>=0,N), !.        % and simplify E>0.

do_norm_expr(A<=B,N) :-
   checktype(A,T),
   do_norm_typed_expr(A,T,X),
   do_norm_typed_expr(B,T,Y),
   (
      X=Y,
      N=true
   ;
      N=(Y>=X)
   ),
   !.

do_norm_expr(A<B,N) :-
   checktype(A, TYPE),
   (
      TYPE=integer
   ;
      TYPE=real
   ),
   !,
   apply(B-A,E),              % write N[B-A] as E
   simp_rel(E>0,N), !.        % and simplify E>0

do_norm_expr(A<B,N) :-
   checktype(A, T),
   do_norm_typed_expr(A, T, X),
   do_norm_typed_expr(B, T, Y),
   (
      X=Y,
      N=false
   ;
      N=(Y>X)
   ),
   !.

do_norm_expr(A>B,N) :- do_norm_expr(B<A,N), !.

% Reduce relational exprs. in logical exprs. to normal form,
% and simplify where possible.

do_norm_expr(not(not(A)),N) :-
    do_norm_expr(A,N),
    !.

do_norm_expr(not(A=B),N) :-
    do_norm_expr(A<>B,N),
    !.

do_norm_expr(not(A<>B),N) :-
    do_norm_expr(A=B,N),
    !.

do_norm_expr(not(A<B),N) :-
    do_norm_expr(A>=B,N),
    !.

do_norm_expr(not(A>B),N) :-
    do_norm_expr(A<=B,N),
    !.

do_norm_expr(not(A<=B),N) :-
    do_norm_expr(A>B,N),
    !.

do_norm_expr(not(A>=B),N) :-
    do_norm_expr(A<B,N),
    !.

do_norm_expr(not(A),not(N)) :-
    do_norm_expr(A,N),
    !.

do_norm_expr(A and B,A1 and B1):-
   do_norm_expr(A,A1),           % write N[A] as A1
   do_norm_expr(B,B1),           % write N[B] as B1
   !.

do_norm_expr(A or B,A1 or B1) :-
   do_norm_expr(A,A1),
   do_norm_expr(B,B1),
   !.

do_norm_expr(A -> B,A1 -> B1):-
   do_norm_expr(A,A1),
   do_norm_expr(B,B1),
   !.

do_norm_expr(A <-> B,A1 <-> B1) :-
   do_norm_expr(A,A1),
   do_norm_expr(B,B1),
   !.

% Quantifiers: reduce boolean expressions to normal form
% and simplify whole expression where possible,
% e.g. 'for_all(x:integer,true)' is equivalent to 'true'

do_norm_expr(for_all(X:T, Exp), for_all(X:T, E1)) :-
    find_core_type(T, CT), !,
    (
       var_const(X, CT, _), !,
       do_norm_expr(Exp, E1)
    ;
       asserta(var_const(X, CT, p)),
       do_norm_expr(Exp, E1),
       retract(var_const(X, CT, p))
    ;
       retract(var_const(X, CT, p)),
       fail
    ),
    !.

do_norm_expr(for_some(X:T, Exp),for_some(X:T, E1)) :-
    find_core_type(T, CT), !,
    (
       var_const(X, CT, _), !,
       do_norm_expr(Exp, E1)
    ;
       asserta(var_const(X, CT, p)),
       do_norm_expr(Exp, E1),
       retract(var_const(X, CT, p))
    ;
       retract(var_const(X, CT, p)),
       fail
    ),
    !.

do_norm_expr(update(A,I,X),Y) :-
    checktype(A,T),
    !,
    do_norm_typed_expr(update(A,I,X),T,Y),
    !.

do_norm_expr(A,B) :-
    defined_funct(A,Arg_types,boolean),
    simp_funct(A,Arg_types,B),
    !.

%-------------------------------------------------------------------------------

% SIMP_REL(E=0,S) - simplify equality expressions where possible

simp_rel(0=0,true) :-
    !.

simp_rel(A=0,false) :-
    s_integer(A),
    \+ (0 is A),
    !.

simp_rel(-A=0,X) :-
    simp_rel(A=0,X),
    !.

simp_rel(A=0,X=Y) :-
    % catch all
    esplint(A, X, Y),
    !.

% SIMP_REL(E<>0,S) - simplify inequality expressions where possible

simp_rel(0<>0,false) :-
    !.

simp_rel(A<>0,true) :-
    s_integer(A),
    \+ (0 is A),
    !.

simp_rel(-A<>0,X) :-
    simp_rel(A<>0,X),
    !.

simp_rel(A<>0,X<>Y) :-
    % catch all
    esplint(A, X, Y),
    !.

% SIMP_REL(E>0,S) - simplify greater-than expressions where possible

simp_rel(-A>0,false):-
    integer(A),
    A>=0,
    !.

simp_rel(0>0,false) :-
    !.

simp_rel(A>0,true) :-
    integer(A),
    A\=0,
    !.

simp_rel(A>0,X>Y) :-
    % catch all
    splint(A, X, Y),
    !.

% SIMP_REL(E<=0,S) - simplify >= expressions (reals) where possible

simp_rel(0>=0,true) :-
    !.

simp_rel(A>=0,TRUTH) :-
    intexp(A),
    VAL iss A,
    (
        VAL >= 0,
        TRUTH = true
    ;
        VAL < 0,
        TRUTH = false
    ),
    !.

simp_rel(A>=0,X>=Y) :-
    % catch all
    splint(A, X, Y),
    !.

%-------------------------------------------------------------------------------

esplint(I+X, X, II) :-
    s_integer(I),
    II iss -I,
    !.

esplint(I-X, X,  I) :-
    s_integer(I),
    !.

esplint(X,   X,  0) :-
    !.

splint(I+X,  X, II) :-
    s_integer(I),
    II iss -I,
    !.

splint(I-X, -X, II) :-
    s_integer(I),
    II iss -I,
    !.

splint(X, X, 0) :-
    !.

%-------------------------------------------------------------------------------

is_a_valid_type(integer).

is_a_valid_type(boolean).

is_a_valid_type(real).

is_a_valid_type(X) :-
    type(X, _).

%-------------------------------------------------------------------------------

built_in((+),                   [integer, integer],     integer).
built_in((-),                   [integer, integer],     integer).
built_in((*),                   [integer, integer],     integer).
built_in((div),                 [integer, integer],     integer).
built_in((/),                   [integer, integer],     integer).
built_in((mod),                 [integer, integer],     integer).
built_in((rem),                 [integer, integer],     integer).
built_in((-),                   [integer],              integer).
built_in((/),                   [real, real],           real   ).
built_in(abs,                   [integer],              integer).
built_in(sqr,                   [integer],              integer).
built_in((=),                   ['ANY', 'ANY'],         boolean).
built_in((<>),                  ['ANY', 'ANY'],         boolean).
built_in((>),                   ['ANY', 'ANY'],         boolean).
built_in((<),                   ['ANY', 'ANY'],         boolean).
built_in((>=),                  ['ANY', 'ANY'],         boolean).
built_in((<=),                  ['ANY', 'ANY'],         boolean).
built_in((not),                 [boolean],              boolean).
built_in((and),                 [boolean, boolean],     boolean).
built_in((or),                  [boolean, boolean],     boolean).
built_in((->),                  [boolean, boolean],     boolean).
built_in((<->),                 [boolean, boolean],     boolean).
built_in(odd,                   [integer],              boolean).
built_in(pred,                  ['ANY'],                'ANY'  ).
built_in(succ,                  ['ANY'],                'ANY'  ).
built_in(length,                ['ANY'],                integer).
built_in(first,                 ['ANY'],                'ANY'  ).
built_in(last,                  ['ANY'],                'ANY'  ).
built_in(nonfirst,              ['ANY'],                'ANY'  ).
built_in(nonlast,               ['ANY'],                'ANY'  ).
built_in((@),                   ['ANY', 'ANY'],         'ANY'  ).
built_in((\/),                  ['ANY', 'ANY'],         'ANY'  ).
built_in((/\),                  ['ANY', 'ANY'],         'ANY'  ).
built_in((/),                   ['ANY', 'ANY'],         'ANY'  ).
built_in((in),                  ['ANY', 'ANY'],         boolean).
built_in((not_in),              ['ANY', 'ANY'],         boolean).
built_in((subset_of),           ['ANY', 'ANY'],         boolean).
built_in((strict_subset_of),    ['ANY', 'ANY'],         boolean).
built_in('.',                   ['ANY', 'ANY'],         'ANY'  ).

%-------------------------------------------------------------------------------

save_term_breakdown(NEW, _) :-
    is_relational_expression(NEW, _Rop, X, _, _),
    know_term_breakdown(X, _),
    !.

save_term_breakdown(NEW, _) :-
    is_relational_expression(NEW, _Rop, X, _, T),
    (
        T = integer
    ;
        T = real
    ),
    !,
    make_breakdown_list(X, LIST),
    assertz(know_term_breakdown(X, LIST)),
    !.

save_term_breakdown(NEW, _) :-
    know_term_breakdown(NEW, _),
    !.

save_term_breakdown(NEW, T) :-
    (
        T = integer
    ;
        T = real
    ),
    !,
    make_breakdown_list(NEW, LIST),
    assertz(know_term_breakdown(NEW, LIST)),
    !.

save_term_breakdown(_, _) :-
    % otherwise
    !.

%-------------------------------------------------------------------------------

make_breakdown_list(X=Y, Z=Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X<>Y, Z<>Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X<=Y, Z<=Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X>=Y, Z>=Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X<Y, Z<Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X>Y, Z>Y) :-
        !,
        make_breakdown_list(X, Z).

make_breakdown_list(X+Y, [[T,I]|REST]) :-
        breakdown_term(Y, T, I),
        !,
        make_breakdown_list(X, REST).

make_breakdown_list(X-Y, [[T,I]|REST]) :-
        breakdown_term(-Y, T, I),
        !,
        make_breakdown_list(X, REST).

make_breakdown_list(X, [[T,I]]) :-
        breakdown_term(X, T, I),
        !.

%-------------------------------------------------------------------------------

breakdown_term(-X, T, I) :-
        breakdown_term(X, T, II),
        I iss -II,
        !.

breakdown_term(X*Y, Y, X) :-
        s_integer(X),
        !.

breakdown_term(X*Y, T*Y, I) :-
        breakdown_term(X, T, I),
        !.

breakdown_term(X, X, 1) :-
        !.

%-------------------------------------------------------------------------------

% Here, calculated normalised forms are cached, to avoid their
% recalculation.
save_norm_expr(OLD, NEW) :-
    assertz(know_norm_expr(OLD, NEW)),
    !.

%###############################################################################
% END-OF-FILE
