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


/******** STANDARDISE: top-level checker command ********/
standardise :-
        (
           command_arg(expression, EXPRESSION)
        ;
           prompt_user('STANDARDISE -- Please specify expression to be standardised.','Expression? '),
           rread(EXPRN),
           parse_expression(EXPRN, EXPRESSION)
        ),
        !,
        standardise(EXPRESSION).

standardise(HORC#N) :-
        (
           HORC=h,
           HC=hyp,
           NHC=newhyp,
           MESSAGE = new_hyp_message(N, F)                      /* CFR018 */
        ;
           HORC=c,
           HC=conc,
           NHC=newconc,
           MESSAGE = new_conc_message(N, F)                     /* CFR018 */
        ),
        X=..[HC,N,E],
        call(X),
        norm_expr(E,F),
        stan_display(E,F),
        ask_if_save(R),
        (
           R=yes,
           retract(X),
           Y=..[HC,N,F],
           assertz(Y),
           Z=..[HC,N],
           assertz(logfact(standardisation, Z)),
           assertz(logfact(NHC, Y)),
           call(MESSAGE)                                        /* CFR018 */
        ;
           R=no,
           !,
           fail
        ), !.

standardise(EXPRESSION) :-
        checktype(EXPRESSION, TYPE),
        norm_typed_expr(EXPRESSION, TYPE, NEW_EXPRESSION),
        stan_display(EXPRESSION, NEW_EXPRESSION),
        ask_if_save(R),
        (
           R=yes,
           assertz(logfact(standardisation, [EXPRESSION, NEW_EXPRESSION])),
           (
              TYPE\=boolean,
              add_new_hyp(EXPRESSION=NEW_EXPRESSION,1)
           ;
              TYPE=boolean,
              (
                 NEW_EXPRESSION=true,
                 add_new_hyp(EXPRESSION,1)
              ;
                 NEW_EXPRESSION=false,
                 add_new_hyp(not EXPRESSION,1)
              ;
                 add_new_hyp(EXPRESSION<->NEW_EXPRESSION,1)
              )
           )
        ;
           R=no,
           !,
           fail
        ), !.


/*** STAN_DISPLAY(OLD,NEW) - display pre- & post-standardised expression ***/
stan_display(E,F) :-
   nl,
   write('OLD: '),
   print(E),
   nl,
   write('NEW: '),
   print(F),
   nl, !.


/*** ASK_IF_SAVE(ANSWER) - read "yes" or "no" ANSWER from user ***/
ask_if_save(R) :-
   repeat,
      nl,
      read_answer('Shall I save this result', R),               /* CFR002 */
   /* until */ (R=yes ; R=no),
   !.

/*-------------------------------------------------------------*/
/*                                                             */
/*     Integer and Boolean Expression Standardisation Module   */
/*                                                             */
/*-------------------------------------------------------------*/

/* MAIN PROCEDURE: Normalise an expression of given type */
norm_typed_expr(OLD, TYPE, NEW) :-
        do_norm_typed_expr(OLD, TYPE, SO_FAR),
        (
           simplify(SO_FAR, NEW)
        ;
           NEW = SO_FAR
        ), !.


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

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

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 ** Y, _, Result) :-                                /* CFR055 */
        simp_args([X, Y], [integer, integer], [XS, YS]),        /* CFR055 */
        (                                                       /* CFR055 */
           YS = 0,                                              /* CFR055 */
           Result = 1                                           /* CFR055 */
        ;                                                       /* CFR055 */
           YS = 1,                                              /* CFR055 */
           Result = XS                                          /* CFR055 */
        ;                                                       /* CFR055 */
           YS = 2,                                              /* CFR055 */
           Result = XS * XS                                     /* CFR055 */
        ;                                                       /* CFR055 */
           XS = 1,                                              /* CFR055 */
           Result = 1                                           /* CFR055 */
        ;                                                       /* CFR055 */
           XS = 0,                                              /* CFR055 */
           integer(YS),                                         /* CFR055 */
           YS >= 1,                                             /* CFR055 */
           Result = 0                                           /* CFR055 */
        ;                                                       /* CFR055 */
           Result = (XS ** YS)                                  /* CFR055 */
        ),                                                      /* CFR055 */
        !.                                                      /* CFR055 */

simp_funct(X,Arg_types,Y):-
   X=..[Name|Arg_list],
   simp_args(Arg_list,Arg_types,Args1), /* simplify arguments. */
   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,B,C,D,E,F,G,H,I,J,K,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).

apply(A,L) :- apply(A,_,_,_,_,_,_,_,_,_,_,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 mod _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 ** _Y) :- !.                                            /* CFR055 */
term(X) :- s_atomic(X), !.
term(X) :- record_function(_, X, _, _, _, _), !.                /* CFR029 */
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 occurances 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 mod Y,A) :-
   standard(X,X1),
   standard(Y,Y1),
   simp_num(X1 mod 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).        /* catch-all */


/* 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 mod Y,Z) - simplify term: X & Y are already in std form */
simp_num(X mod Y,Z) :-
   s_integer(X),
   s_integer(Y),
   Z iss X mod Y, !.

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

simp_num(_X mod 1,0) :- !.

simp_num(X,X) :- !.     /* Catch all */


/* 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) :-
   leftint(X,Z), !.             /* implicit: (\+ s_integer(Y)) */

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) :-
   list_terms(X,Z),      /* Put in list form */
   busort_terms(Z,W),    /* Bubble sort the terms */
   list_terms(Y,W), !.   /* Reform product */


/*** 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) :- !.


/*** GEN_APPEND(L1,L2,LL) - general (i.e. nondeterministic) append ***/
gen_append([],L,L).
gen_append([H|T],L,[H|V]) :- gen_append(T,L,V).


/*** ORDER_TERMS(OLD,NEW) - succeeds if arguments are in required order ***/
order_terms(A div B,C div B) :-                       /* ORDER 'div' EXPRNS */
   !,
   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 mod _B,_C div _D) :-                         /* ORDER mod EXPRNS */
   !,
   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) :-
   s_atomic(B),                 /* implicit: (\+ s_atomic(A)) */
   !,
   fail.

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

order_terms(A,B) :-
   !,
   A=..Function1,    /* put functions  */
   B=..Function2,    /*  in list form  */
   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]) :-      /* 24/1/91: Last ditch? */
        !,
        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([],_) :- !.

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) :-
   term(Y), !.                  /* implicit: (\+ s_integer(Y)) */

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

essence(X,X,1) :-
   term(X), !.                  /* implicit: (\+ s_integer(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]) :-
   nozeros(T,Z), !.                     /* implicit: (\+ zero(X)) */

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],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-Y) :- tidy(X,Z), !.
tidy(X+Y,Z+Y) :- tidy(X,Z), !.
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 quantifers & boolean functions. */

/*** NORM_EXPR(OLD,NEW) - normalise boolean expression OLD to get NEW ***/
norm_expr(OLD, NEW) :-
        do_norm_expr(OLD, SO_FAR),
        (
           simplify(SO_FAR, NEW)
        ;
           NEW = SO_FAR
        ), !.

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) :- atomic(E), !.   /* boolean variable */

/* 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(A-B,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=(X<=Y)
   ),
   !.

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=(X<Y)
   ),
   !.

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,A=0) :- !.
simp_rel(A=0,A=0) :- !.    /* catch all */


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

simp_rel(0<>0,false) :-!.
simp_rel(A<>0,true) :- integer(A), \+ (0 is A), !.
simp_rel(-A<>0,A<>0) :- !.
simp_rel(A<>0,A<>0) :- !.  /* catch all */


/*** 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,A>0) :- !.    /* catch all */

/*** 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,
        (
           A =< 0,
           TRUTH = true
        ;
           A > 0,
           TRUTH = false
        ), !.
simp_rel(A<=0,A<=0) :- !.   /* catch all */


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((mod),                 [integer, integer],     integer).
built_in((**),                  [integer, integer],     integer).   /* CFR055 */
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'  ).
%###############################################################################
%END-OF-FILE
