diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 889ad00747cba18576524c8357c62fc0037f5ae5..7707c66665d0f28f0bb65121d2a74e13cef24dbe 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1,5 +1,6 @@
tests_without_recompilation:
- image: debian
+ #debian/stable
+ image: debian@sha256:7ceacc4462a98718b236cbdeb850d4b7603afe4bab791336a0ed1c030f769f02
script:
- apt-get update
- apt-get install -y ocaml-nox
@@ -21,7 +22,8 @@ tests_without_recompilation:
- docker
tests_with_recompilation:
- image: ocaml/opam@sha256:c4dc0b8c0fefabeec52a4b596bd3fbdd8fe63d772167303fc24913a3cee79d89
+ #ocaml/opam:debian-10-ocaml-4.11
+ image: ocaml/opam@sha256:e570e5dd74bb4986e022d5c25fe42579288d11fb0b60df13794632a8f0a110b6
script:
- rm -f Src/COLIBRI/lib/v7/x86_64_linux/* Src/COLIBRI/simplex_ocaml.pl
#OCaml dependencies
diff --git a/Src/COLIBRI/arith.pl b/Src/COLIBRI/arith.pl
index fbd9e800d79c14ee7a2e69aa46816303ceec76e9..1fee14576f1e01806eff4f0cc199c8bedc59078c 100755
--- a/Src/COLIBRI/arith.pl
+++ b/Src/COLIBRI/arith.pl
@@ -71,12 +71,12 @@ no_lin_add(A,B,C) :-
add_int(A,TA,B,TB,C,TC) :-
- get_priority(Prio),
- set_priority(1),
+ get_priority(Prio),
+ set_priority(1),
check_add_opp(A,B,C,Continue),
(var(Continue) ->
true
- ; add_bis(A,TA,B,TB,C,TC)),
+ ; add_bis(A,TA,B,TB,C,TC)),
set_priority(Prio),
wake_if_other_scheduled(Prio).
@@ -535,60 +535,60 @@ check_dist_mult_add0(mult_int,A,B,C) :-
%% Exploitation d'instanciations
add_inst_free(A,B,C,Continue) :-
- (integer(A) ->
- (integer(B) ->
- C0 is A + B,
+ (integer(A) ->
+ (integer(B) ->
+ C0 is A + B,
protected_unify(C,C0)
- ; (integer(C) ->
- B0 is C - A,
+ ; (integer(C) ->
+ B0 is C - A,
protected_unify(B,B0)
- ; (A == 0 ->
- protected_unify(B = C)
- ; add_free(A,B,C,Continue))))
- ; (integer(B) ->
- (integer(C) ->
- A0 is C - B,
+ ; (A == 0 ->
+ protected_unify(B = C)
+ ; add_free(A,B,C,Continue))))
+ ; (integer(B) ->
+ (integer(C) ->
+ A0 is C - B,
protected_unify(A,A0)
- ; (B == 0 ->
- protected_unify(A = C)
- ; add_free(A,B,C,Continue)))
- ; (C == 0 ->
- op(A,B)
- ; add_free(A,B,C,Continue)))).
+ ; (B == 0 ->
+ protected_unify(A = C)
+ ; add_free(A,B,C,Continue)))
+ ; (C == 0 ->
+ op(A,B)
+ ; add_free(A,B,C,Continue)))).
%% Exploitation d'identites entre arguments
%% et autres simplifs algebriques
add_free(A,B,C,Continue) :-
- (A == C ->
- protected_unify(B = 0)
- ; (B == C ->
- protected_unify(A = 0)
- ; check_exists_op_int_with_add_args(A,B,C,Continue0),
- (var(Continue0) ->
- true
- ; add_two_value_domain(A,B,C,Stop),
- (nonvar(Stop) ->
- true
- ; merge_add_mult(A,B,C,Continue))))).
+ (A == C ->
+ protected_unify(B = 0)
+ ; (B == C ->
+ protected_unify(A = 0)
+ ; check_exists_op_int_with_add_args(A,B,C,Continue0),
+ (var(Continue0) ->
+ true
+ ; add_two_value_domain(A,B,C,Stop),
+ (nonvar(Stop) ->
+ true
+ ; merge_add_mult(A,B,C,Continue))))).
check_exists_op_int_with_add_args(A,B,C,Continue) :-
- ((get_saved_cstr_suspensions(LS),
- member((Susp,op_int(X,Y)),LS),
- (((A,B) == (X,Y);
- (A,B) == (Y,X)),
- Goal = protected_unify(C=0); %% le add_int va devenir un op_int identique
- ((C == Y,
- (A == X,Vd2=A,V=B; %% op(A,C) donc -2*A = B qui est plus precis que A+B=-A
- B == X,Vd2=B,V=A)); %% op(B,C) donc -2*B = A
- C == X,
- (A == Y,Vd2=A,V=B; %% op(C,A) donc -2*A = B
- B == Y,Vd2=B,V=A)), %% op(C,B) donc -2*B = A
- Goal = (mult(-2,Vd2,V))))
- ->
- check_and_call_goals([Goal])
- ; Continue = 1).
+ ((get_saved_cstr_suspensions(LS),
+ member((Susp,op_int(X,Y)),LS),
+ (((A,B) == (X,Y);
+ (A,B) == (Y,X)),
+ Goal = protected_unify(C=0); %% le add_int va devenir un op_int identique
+ ((C == Y,
+ (A == X,Vd2=A,V=B; %% op(A,C) donc -2*A = B qui est plus precis que A+B=-A
+ B == X,Vd2=B,V=A)); %% op(B,C) donc -2*B = A
+ C == X,
+ (A == Y,Vd2=A,V=B; %% op(C,A) donc -2*A = B
+ B == Y,Vd2=B,V=A)), %% op(C,B) donc -2*B = A
+ Goal = (mult(-2,Vd2,V))))
+ ->
+ check_and_call_goals([Goal])
+ ; Continue = 1).
add_two_value_domain(A,B,C,Stop) :-
@@ -605,7 +605,9 @@ add_two_value_domain(A,B,C,Stop) :-
D2 = [Min,Max],
C is Min + Max,
get_saved_cstr_suspensions(LCstr),
- ((member((_,diff_int(X,Y)),LCstr),
+ ((member((Susp,diff_int(X,Y)),LCstr),
+ get_suspension_data(Susp,state,State),
+ occurs(State,(0,1)),
(X == A -> Y == B; X == B, Y == A))
->
Stop = 1
@@ -618,7 +620,7 @@ add_two_value_domain(A,B,C,Stop) :-
V1 is Max - Min,
V2 is - V1,
mfd:(Var :: [V1,V2])
- ; true))
+ ; true))
; ((two_value_domain(C,D2),
exists_diff_Rel(A,C))
->
@@ -652,107 +654,107 @@ add_two_value_domain(A,B,C,Stop) :-
%% (aucune reduction si on ne le teste pas et ne coute rien car on a
%% deja recupere les mult_int qui calculent C)
merge_add_mult(A,B,C,Continue) :-
- %% Generalisation du cas A = B dans A + B = C -> 2*A = C
- %% si A = cA * X et B = cB * X alors C = X * (cA + cB)
- each_is_mult_of_same_other(A,B,C,LDA,LDB,Continue1),
- (var(Continue1) ->
- true
- ; %% LDA (idem LDB) contient les paires (cA,Var)
- %% tels que "A = cA*Var"
- get_mult_susp_giving_var(C,LMV),
- (LMV == [] ->
- Continue = 1
- ; ((member((X,Y,Susp),LMV), %% S :: X*Y=C
- ((((A,B) == (X,Y);
- (A,B) == (Y,X)),
- ABeqApB = 1); %% On a A + B = C et A * B = C
- (((nonvar(X), %% C = CstX * Y,
- CoeffC = X,
- ArgC = Y;
- nonvar(Y), %% C = CstY * X
- CoeffC = Y,
- ArgC = X),
- (member((Coeff1,Arg1),LDA),
- Arg1 == ArgC,
- Arg2 = B;
- member((Coeff1,Arg1),LDB),
- Arg1 == ArgC,
- Arg2 = A))))) %% On a CoeffC*ArgC = C et Coeff1*ArgC + Arg2 = C
- %% Donc Arg2 = Coeff2 * NArg2 avec Coeff2 = CoeffC - Coeff1
- ->
- (var(ABeqApB) ->
- %% On a CoeffC*ArgC = C et Coeff1*ArgC + Arg2 = C
- %% Donc Arg2 = (CoeffC - Coeff1) * ArgC avec Coeff2 = CoeffC - Coeff1
- %% et on abandonne "A + B = C"
- Coeff2 is CoeffC - Coeff1,
- mult(Coeff2,ArgC,Arg2)
- ; %% A * B = A + B = C, on arrete le add_int,
- %% A=B (A=0 et B=0 ou bien A|B et B|A)
- %% A : [0,2], C : [0,4] et le add devient un x2
- %% A*B disparait (et A+B apres)
- kill_suspension(Susp),
- protected_unify(A = B),
- mfd:(A::[0,2]),
- mfd:(C::[0,4]),
- no_lin_mult(2,A,C))
- ; Continue = 1))).
+ % Generalisation du cas A = B dans A + B = C -> 2*A = C
+ % si A = cA * X et B = cB * X alors C = X * (cA + cB)
+ each_is_mult_of_same_other(A,B,C,LDA,LDB,Continue1),
+ (var(Continue1) ->
+ true
+ ; % LDA (idem LDB) contient les paires (cA,Var)
+ % tels que "A = cA*Var"
+ get_mult_susp_giving_var(C,LMV),
+ (LMV == [] ->
+ Continue = 1
+ ; ((member((X,Y,Susp),LMV), %% S :: X*Y=C
+ ((((A,B) == (X,Y);
+ (A,B) == (Y,X)),
+ ABeqApB = 1); %% On a A + B = C et A * B = C
+ (((nonvar(X), %% C = CstX * Y,
+ CoeffC = X,
+ ArgC = Y;
+ nonvar(Y), %% C = CstY * X
+ CoeffC = Y,
+ ArgC = X),
+ (member((Coeff1,Arg1),LDA),
+ Arg1 == ArgC,
+ Arg2 = B;
+ member((Coeff1,Arg1),LDB),
+ Arg1 == ArgC,
+ Arg2 = A))))) %% On a CoeffC*ArgC = C et Coeff1*ArgC + Arg2 = C
+ %% Donc Arg2 = Coeff2 * NArg2 avec Coeff2 = CoeffC - Coeff1
+ ->
+ (var(ABeqApB) ->
+ % On a CoeffC*ArgC = C et Coeff1*ArgC + Arg2 = C
+ % Donc Arg2 = (CoeffC - Coeff1) * ArgC avec Coeff2 = CoeffC - Coeff1
+ % et on abandonne "A + B = C"
+ Coeff2 is CoeffC - Coeff1,
+ mult(Coeff2,ArgC,Arg2)
+ ; % A * B = A + B = C, on arrete le add_int,
+ % A=B (A=0 et B=0 ou bien A|B et B|A)
+ % A : [0,2], C : [0,4] et le add devient un x2
+ % A*B disparait (et A+B apres)
+ kill_suspension(Susp),
+ protected_unify(A = B),
+ mfd:(A::[0,2]),
+ mfd:(C::[0,4]),
+ no_lin_mult(2,A,C))
+ ; Continue = 1))).
each_is_mult_of_same_other(A,B,C,LDA,LDB,Continue) :-
- %% On a "QA*Other = A", "QB*Other = B"
- %% et "A + B = C"
- %% => (QA + QB) * Other = C
- get_divisors(A,LDA),
- get_divisors(B,LDB),
- ((LDA \== [],
- LDB \== [],
- member((QA,OtherA),LDA),
- member((QB,OtherB),LDB),
- OtherA == OtherB)
- ->
- NewQOther is QA + QB,
- no_lin_mult(NewQOther,OtherA,C)
- ; Continue = 1).
+ % On a "QA*Other = A", "QB*Other = B"
+ % et "A + B = C"
+ % => (QA + QB) * Other = C
+ get_divisors(A,LDA),
+ get_divisors(B,LDB),
+ ((LDA \== [],
+ LDB \== [],
+ member((QA,OtherA),LDA),
+ member((QB,OtherB),LDB),
+ OtherA == OtherB)
+ ->
+ NewQOther is QA + QB,
+ no_lin_mult(NewQOther,OtherA,C)
+ ; Continue = 1).
- %% collecte des (Q,V) dans les contraintes
- %% tels que Q*V=Var avec Q instanciee
- get_divisors(Var,LD) :-
- var(Var),!,
- (exists_congr(Var,0,_) ->
- %% Un diviseur de Var est connu
- get_saved_cstr_suspensions(LSusp),
- get_divisors(LSusp,Var,LD)
- ; LD = [(1,Var)]).
+% collecte des (Q,V) dans les contraintes
+% tels que Q*V=Var avec Q instanciee
+get_divisors(Var,LD) :-
+ var(Var),!,
+ (exists_congr(Var,0,_) ->
+ % Un diviseur de Var est connu
+ get_saved_cstr_suspensions(LSusp),
+ get_divisors(LSusp,Var,LD)
+ ; LD = [(1,Var)]).
get_divisors(_,[]).
- get_divisors([],Var,[(1,Var)]).
- get_divisors([(Susp,Goal)|LSusp],Var,LD) :-
- ((Goal = mult_int(X,_,Y,_,Z,_),
- Z == Var,
- ((nonvar(X), Q = X, Other = Y);
- (nonvar(Y), Q = Y, Other = X)))
- ->
- LD = [(Q,Other)|NLD],
- get_divisors(LSusp,Var,NLD)
- ; get_divisors(LSusp,Var,LD)).
+get_divisors([],Var,[(1,Var)]).
+get_divisors([(Susp,Goal)|LSusp],Var,LD) :-
+ ((Goal = mult_int(X,_,Y,_,Z,_),
+ Z == Var,
+ ((nonvar(X), Q = X, Other = Y);
+ (nonvar(Y), Q = Y, Other = X)))
+ ->
+ LD = [(Q,Other)|NLD],
+ get_divisors(LSusp,Var,NLD)
+ ; get_divisors(LSusp,Var,LD)).
- %% collecte des (X,Y,S) tels que S est un mult_int(X,_,Y,_,V,_)
- %% dans les contraintes de Var
- get_mult_susp_giving_var(V,LMV) :-
- var(V),!,
- get_saved_cstr_suspensions(LSusp),
- get_mult_susp_giving_var(V,LSusp,LMV).
- get_mult_susp_giving_var(_,[]).
+% collecte des (X,Y,S) tels que S est un mult_int(X,_,Y,_,V,_)
+% dans les contraintes de Var
+get_mult_susp_giving_var(V,LMV) :-
+ var(V),!,
+ get_saved_cstr_suspensions(LSusp),
+ get_mult_susp_giving_var(V,LSusp,LMV).
+get_mult_susp_giving_var(_,[]).
- get_mult_susp_giving_var(_,[],[]).
- get_mult_susp_giving_var(Var,[(S,G)|LS],LMV) :-
- ((G = mult_int(X,_,Y,_,Z,_),
- Var == Z)
- ->
- LMV = [(X,Y,S)|NLMV]
- ; NLMV = LMV),
- get_mult_susp_giving_var(Var,LS,NLMV).
+get_mult_susp_giving_var(_,[],[]).
+get_mult_susp_giving_var(Var,[(S,G)|LS],LMV) :-
+ ((G = mult_int(X,_,Y,_,Z,_),
+ Var == Z)
+ ->
+ LMV = [(X,Y,S)|NLMV]
+ ; NLMV = LMV),
+ get_mult_susp_giving_var(Var,LS,NLMV).
@@ -933,7 +935,7 @@ add_interval(Val1,Val2,Val) :-
; true)),
list_to_intervals(integer,LInter,InterAdd),
mfd:quiet_set_intervals(Val,InterAdd))),
- congr_add_directe(Val1,Val2,Val).
+ congr_add_directe(int,Val1,Val2,Val).
@@ -1078,7 +1080,7 @@ minus_interval(Val1,Val2,Val) :-
; true)),
list_to_intervals(integer,LInter,InterMinus),
mfd:quiet_set_intervals(Val,InterMinus))),
- congr_add_inverse(Val1,Val2,Val).
+ congr_add_inverse(int,Val1,Val2,Val).
:- mode(minus_intervals(++,++,-,-)).
minus_intervals(ValInter1,ValInter2,B1,B2) :-
@@ -1147,16 +1149,16 @@ minus_interval_list_bis(Min1,Max1,[I2|LI2],MinInt,MaxInt,_,LastTooBig,LI,ELI) :-
%% A = -B
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
op(A,B) :-
- set_lazy_domain(int,A),
- (get_type(B,int) ->
- true
- ; mfd:dvar_range(A,MinA,MaxA),
- MinB is -MaxA,
- MaxB is -MinA,
- interval_from_bounds(MinB,MaxB,IB),
- mfd:quiet_set_intervals(B,[IB])),
- lin_op_int(A,B),
- op_int(A,B).
+ set_lazy_domain(int,A),
+ (get_type(B,int) ->
+ true
+ ; mfd:dvar_range(A,MinA,MaxA),
+ MinB is -MaxA,
+ MaxB is -MinA,
+ interval_from_bounds(MinB,MaxB,IB),
+ mfd:quiet_set_intervals(B,[IB])),
+ lin_op_int(A,B),
+ op_int(A,B).
/*
@@ -1164,65 +1166,65 @@ no_lin_op(A,B) :- !,
op(A,B).
*/
no_lin_op(A,B) :-
- set_lazy_domain(int,A),
- (get_type(B,int) ->
- true
- ; mfd:dvar_range(A,MinA,MaxA),
- MinB is -MaxA,
- MaxB is -MinA,
- interval_from_bounds(MinB,MaxB,IB),
- mfd:quiet_set_intervals(B,[IB])),
- op_int(A,B).
+ set_lazy_domain(int,A),
+ (get_type(B,int) ->
+ true
+ ; mfd:dvar_range(A,MinA,MaxA),
+ MinB is -MaxA,
+ MaxB is -MinA,
+ interval_from_bounds(MinB,MaxB,IB),
+ mfd:quiet_set_intervals(B,[IB])),
+ op_int(A,B).
op_int(A,B) :-
- get_priority(Prio),
- set_priority(1),
- op_int_bis(A,B),
- set_priority(Prio),
- wake_if_other_scheduled(Prio).
+ get_priority(Prio),
+ set_priority(1),
+ op_int_bis(A,B),
+ set_priority(Prio),
+ wake_if_other_scheduled(Prio).
op_int_bis(A,B) :-
- (A == B ->
- protected_unify(A = 0)
- ; op_int_inst(A,B,Continue),
- (var(Continue) ->
- true
- ; mfd:get_intervals(A,IA),
- mfd:get_intervals(B,IB),
- save_cstr_suspensions((A,B)),
- %% Factorisation op_int
- check_exists_op_int_with_op_arg(A,B),
- %% Prise en compte du delta existant
- check_op_delta(A,B),
- %% Point fixe (et lancement de delta)
- op_int_rec(A,B),
- int_check_notify_constrained(A,IA),
- int_check_notify_constrained(B,IB),
- check_before_susp_op(A,B))).
+ (A == B ->
+ protected_unify(A = 0)
+ ; op_int_inst(A,B,Continue),
+ (var(Continue) ->
+ true
+ ; mfd:get_intervals(A,IA),
+ mfd:get_intervals(B,IB),
+ save_cstr_suspensions((A,B)),
+ % Factorisation op_int
+ check_exists_op_int_with_op_arg(A,B),
+ % Prise en compte du delta existant
+ check_op_delta(A,B),
+ % Point fixe (et lancement de delta)
+ op_int_rec(A,B),
+ int_check_notify_constrained(A,IA),
+ int_check_notify_constrained(B,IB),
+ check_before_susp_op(A,B))).
op_int_inst(A,B,Continue) :-
- (integer(A) ->
- B0 is -A,
+ (integer(A) ->
+ B0 is -A,
protected_unify(B,B0)
- ; (integer(B) ->
- A0 is -B,
+ ; (integer(B) ->
+ A0 is -B,
protected_unify(A,A0)
- ; Continue = 1)).
+ ; Continue = 1)).
op_int_rec(A,B) :-
- op_interval(A,B),
- op_interval(B,A),
- mfd:get_intervals(A,IA),
- mfd:get_intervals(B,IB),
- saturate_op_inequalities(A,B),
- mfd:get_intervals(A,NIA),
- mfd:get_intervals(B,NIB),
- ((NIA,NIB) == (IA,IB) ->
- true
- ; %% Les deltas ont modifie A et/ou B
- op_int_rec(A,B)).
+ op_interval(A,B),
+ op_interval(B,A),
+ mfd:get_intervals(A,IA),
+ mfd:get_intervals(B,IB),
+ saturate_op_inequalities(A,B),
+ mfd:get_intervals(A,NIA),
+ mfd:get_intervals(B,NIB),
+ ((NIA,NIB) == (IA,IB) ->
+ true
+ ; % Les deltas ont modifie A et/ou B
+ op_int_rec(A,B)).
%% On est sur op(A,B), si on trouve op(A,X)
%% alors X = B et op(A,X) disparait
@@ -1243,83 +1245,83 @@ check_exists_op_int_with_op_arg(A,B) :-
%% Prise en compte du delta existant
check_op_delta(A,B) :-
- %% Un peu de menage sur les bornes de A et B
- mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- NMinA is max(MinA,-MaxB),
- NMaxA is min(MaxA,-MinB),
- NMinB is -NMaxA,
- NMaxB is -NMinA,
- mfd:(A :: NMinA..NMaxA),
- mfd:(B :: NMinB..NMaxB),
- (not_unify(B,0) ->
- mfd:dvar_remove_element(A,0)
- ; (not_unify(A,0) ->
- mfd:dvar_remove_element(B,0)
- ; true)),
- (ndelta:get_deltas(A,B,S,C) ->
- %% La distance doit etre paire
- reduce_congr_bounds_interval_list([C],0,2,IL),
- ((IL = [NC0],
- number(NC0))
- ->
- NS = '=',
- NC = NC0
- ; interval_range(IL,Low,High),
- NS = S,
- NC = Low..High),
- apply_delta_op(NS,NC,A,B),
- ((NS,NC) == (S,C) ->
- true
- ; launch_delta(A,B,NS,NC))
- ; true).
-
- apply_delta_op('=',C,A,B) :- !,
- B is C div 2,
- A is -B.
- apply_delta_op(S,Low..High,A,B) :-
- NMinB is max(Low div 2,mfd:mindomain(B)),
- NMaxB is min(High div 2,mfd:maxdomain(B)),
- NMaxA is -NMinB,
- NMinA is -NMaxB,
- mfd:(A :: NMinA..NMaxA),
- mfd:(B :: NMinB..NMaxB),
- (S == '#' ->
- mfd:dvar_remove_element(A,0),
- mfd:dvar_remove_element(B,0)
- ; true).
+ % Un peu de menage sur les bornes de A et B
+ mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ NMinA is max(MinA,-MaxB),
+ NMaxA is min(MaxA,-MinB),
+ NMinB is -NMaxA,
+ NMaxB is -NMinA,
+ mfd:(A :: NMinA..NMaxA),
+ mfd:(B :: NMinB..NMaxB),
+ (not_unify(B,0) ->
+ mfd:dvar_remove_element(A,0)
+ ; (not_unify(A,0) ->
+ mfd:dvar_remove_element(B,0)
+ ; true)),
+ (ndelta:get_deltas(A,B,S,C) ->
+ % La distance doit etre paire
+ reduce_congr_bounds_interval_list([C],0,2,IL),
+ ((IL = [NC0],
+ number(NC0))
+ ->
+ NS = '=',
+ NC = NC0
+ ; interval_range(IL,Low,High),
+ NS = S,
+ NC = Low..High),
+ apply_delta_op(NS,NC,A,B),
+ ((NS,NC) == (S,C) ->
+ true
+ ; launch_delta(A,B,NS,NC))
+ ; true).
+
+apply_delta_op('=',C,A,B) :- !,
+ B is C div 2,
+ A is -B.
+apply_delta_op(S,Low..High,A,B) :-
+ NMinB is max(Low div 2,mfd:mindomain(B)),
+ NMaxB is min(High div 2,mfd:maxdomain(B)),
+ NMaxA is -NMinB,
+ NMinA is -NMaxB,
+ mfd:(A :: NMinA..NMaxA),
+ mfd:(B :: NMinB..NMaxB),
+ (S == '#' ->
+ mfd:dvar_remove_element(A,0),
+ mfd:dvar_remove_element(B,0)
+ ; true).
op_interval(A,B) :-
- number(A),!,
- B0 is -A,
+ number(A),!,
+ B0 is -A,
protected_unify(B = B0).
op_interval(A,B) :-
- mfd:get_intervals(A,InterA),
- (mfd:mindomain(B,MinB) ->
- true
- ; % B non initialise
- mfd:maxdomain(A,MaxA),
- MinB is -MaxA),
- op_intervals(InterA,MinB,[],OpInterA),
- mfd:set_intervals(B,OpInterA),
- congr_op_directe(A,B).
+ mfd:get_intervals(A,InterA),
+ (mfd:mindomain(B,MinB) ->
+ true
+ ; % B non initialise
+ mfd:maxdomain(A,MaxA),
+ MinB is -MaxA),
+ op_intervals(InterA,MinB,[],OpInterA),
+ mfd:set_intervals(B,OpInterA),
+ congr_op_directe(int,A,B).
op_intervals([],_,Op,Op).
op_intervals([IV|LIV],MinB,Seen,OpLIV) :-
- (integer(IV) ->
- NIV is -IV,
- Max = NIV
- ; IV = BI..BS,
- NBI is -BS,
- NBS is -BI,
- NIV = NBI..NBS,
- Max = NBS),
- (Max < MinB ->
- %% Inutile de continuer car on est deja en dessous de MinB
- OpLIV = Seen
- ; op_intervals(LIV,MinB,[NIV|Seen],OpLIV)).
+ (integer(IV) ->
+ NIV is -IV,
+ Max = NIV
+ ; IV = BI..BS,
+ NBI is -BS,
+ NBS is -BI,
+ NIV = NBI..NBS,
+ Max = NBS),
+ (Max < MinB ->
+ % Inutile de continuer car on est deja en dessous de MinB
+ OpLIV = Seen
+ ; op_intervals(LIV,MinB,[NIV|Seen],OpLIV)).
check_before_susp_op(A,B) :-
@@ -1329,7 +1331,6 @@ check_before_susp_op(A,B) :-
; % Les add, mult
% peuvent exploiter un op entre leurs arguments
schedule_common_suspensions(A,B),
-
my_suspend(op_int(A,B),4,(A,B)->suspend:constrained)).
@@ -1337,33 +1338,33 @@ check_before_susp_op(A,B) :-
%% C = A - B
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
minus(A,B,C) :-
- set_lazy_domain(int,A),
- set_lazy_domain(int,B),
- (get_type(C,int) ->
- true
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- MinC is MinA-MaxB,
- MaxC is MaxA-MinB,
- mfd:(C::MinC..MaxC)),
- add(B,C,A).
+ set_lazy_domain(int,A),
+ set_lazy_domain(int,B),
+ (get_type(C,int) ->
+ true
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ MinC is MinA-MaxB,
+ MaxC is MaxA-MinB,
+ mfd:(C::MinC..MaxC)),
+ add(B,C,A).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% C = A * B
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
mult(A,A,C) ?- !,
- power(A,2,C).
+ power(A,2,C).
mult(A,B,C) :-
- set_lazy_domain(int,A),
- set_lazy_domain(int,B),
- (get_type(C,int) ->
- true
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- mult_intervals(MinA..MaxA,MinB..MaxB,MinC,MaxC),
- mfd:quiet_set_intervals(C,[MinC..MaxC])),
- lin_mult_int(A,B,C),
- mult_int(A,1,B,1,C,1).
+ set_lazy_domain(int,A),
+ set_lazy_domain(int,B),
+ (get_type(C,int) ->
+ true
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ mult_intervals(MinA..MaxA,MinB..MaxB,MinC,MaxC),
+ mfd:quiet_set_intervals(C,[MinC..MaxC])),
+ lin_mult_int(A,B,C),
+ mult_int(A,1,B,1,C,1).
/*
@@ -1371,16 +1372,16 @@ no_lin_mult(A,B,C) :- !,
mult(A,B,C).
*/
no_lin_mult(A,B,C) :-
- set_lazy_domain(int,A),
- set_lazy_domain(int,B),
- (get_type(C,int) ->
- true
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- mult_intervals(MinA..MaxA,MinB..MaxB,MinC,MaxC),
- mfd:quiet_set_intervals(C,[MinC..MaxC])),
- set_lazy_domain(int,C),
- mult_int(A,1,B,1,C,1).
+ set_lazy_domain(int,A),
+ set_lazy_domain(int,B),
+ (get_type(C,int) ->
+ true
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ mult_intervals(MinA..MaxA,MinB..MaxB,MinC,MaxC),
+ mfd:quiet_set_intervals(C,[MinC..MaxC])),
+ set_lazy_domain(int,C),
+ mult_int(A,1,B,1,C,1).
mult_int(A,_,A,_,C,_) ?- !,
@@ -1411,7 +1412,7 @@ mult_bis(A,TA,B,TB,C,TC) :-
save_cstr_suspensions((A,B,C)),
% Point fixe sur les projections de congruence
% on peut aller jusqu'a instancier A,B ou C
- fp_congr_mult(A,B,C),
+ fp_congr_mult(int,A,B,C),
mult_inst(A,B,C,Continue),
(var(Continue) ->
true
@@ -1450,9 +1451,9 @@ mult_bis(A,TA,B,TB,C,TC) :-
check_exists_power_int_with_mult_args(X,Y,Z,1,Continue) ?- !,
((get_saved_cstr_suspensions(LS),
member((Susp,power_int(A,_,N,B,_)),LS),
- B == Z, %% A^N = Z
- (A == X, V = Y; %% A*Y = Z
- A == Y, V = X)) %% A*X = Z
+ B == Z, % A^N = Z
+ (A == X, V = Y; % A*Y = Z
+ A == Y, V = X)) % A*X = Z
->
PN is N - 1,
(not_unify(A,0) ->
@@ -1558,22 +1559,22 @@ mult_free(A,B,C,NContinue) :-
check_exists_op_int_with_mult_args(X,Y,Z,Continue) :-
- ((var(Z),
- get_saved_cstr_suspensions(LS),
- member((Susp,op_int(A,B)),LS),
- ((((A,B) == (X,Z);(A,B) == (Z,X)),Var = Y %% -X * Y = X
- ;((A,B) == (Y,Z);(A,B) == (Z,Y)),Var = X),%% X * -Y = Y
- %% si A <> 0 alors Var = -1 et le mult_int disparait
- %% si Var <> -1 alors A=B= 0 et le mult_int disparait
- (not_unify(A,0),Goal = (Var = -1);
- not_unify(Var,-1),Goal = (kill_suspension(Susp),protected_unify(A=0),protected_unify(B=0)));
- ((A,B) == (X,Y); %% X * -X = Z
- (A,B) == (Y,X)), %% -X * X = Z
- %% - X^2 = Z, le mult_int disparait
- Goal = (power(X,2,OpZ),no_lin_op(Z,OpZ))))
- ->
- call(Goal)
- ; Continue = 1).
+ ((var(Z),
+ get_saved_cstr_suspensions(LS),
+ member((Susp,op_int(A,B)),LS),
+ ((((A,B) == (X,Z);(A,B) == (Z,X)),Var = Y %% -X * Y = X
+ ;((A,B) == (Y,Z);(A,B) == (Z,Y)),Var = X),%% X * -Y = Y
+ % si A <> 0 alors Var = -1 et le mult_int disparait
+ % si Var <> -1 alors A=B= 0 et le mult_int disparait
+ (not_unify(A,0),Goal = (Var = -1);
+ not_unify(Var,-1),Goal = (kill_suspension(Susp),protected_unify(A=0),protected_unify(B=0)));
+ ((A,B) == (X,Y); %% X * -X = Z
+ (A,B) == (Y,X)), %% -X * X = Z
+ %% - X^2 = Z, le mult_int disparait
+ Goal = (power(X,2,OpZ),no_lin_op(Z,OpZ))))
+ ->
+ call(Goal)
+ ; Continue = 1).
mult_free_proj(A,TA,B,TB,C,TC) :-
mult_free_rec(5,A,TA,B,TB,C,TC).
@@ -1819,164 +1820,164 @@ launch_mult_mult_int_ineqs(Susp,D,SD,NZD,AA,BB,C,Z) :-
patch_mult_bool(A,B,C,1,Continue) ?- !,
- ((two_value_domain(A,[0,1]),
- two_value_domain(B,[0,1]),
- exists_diff_Rel(A,B))
- ->
- %% Le produit de deux variables "booleennes"
- %% differentes est nul
- %% Le mult peut disparaitre car le 'diff' porte
- %% autant d'information
- protected_unify(C = 0)
- ; Continue = 1).
+ ((two_value_domain(A,[0,1]),
+ two_value_domain(B,[0,1]),
+ exists_diff_Rel(A,B))
+ ->
+ % Le produit de deux variables "booleennes"
+ % differentes est nul
+ % Le mult peut disparaitre car le 'diff' porte
+ % autant d'information
+ protected_unify(C = 0)
+ ; Continue = 1).
patch_mult_bool(_,_,_,Continue,Continue).
%% Simplicications algebriques d'un mult avec mult/power/add
merge_mult_power_add(A,B,C,Continue,_) :-
- var(Continue),!.
+ var(Continue),!.
merge_mult_power_add(A,B,C,_,Continue) :-
- %% Simplification : on cherche "A = C1*X" et "B = C2*X"
- check_divisors_launch_mult_power(A,B,C,LDA,LDB,Continue1),
- (var(Continue1) ->
- true
- ; get_roots_add_susps(A,LRA,_),
- get_roots_add_susps(B,LRB,_),
- %% Simplification : on cherche "A = RA^PA", "B = RB^PB" avec RA=RB
- ((LRB \== [],
- member((PA,RA),LRA),
- member((PB,RB),LRB),
- RA == RB)
- ->
- %% RA^PA * RA^PB = RA^(PA+PB)
- %% On delegue a power
- NPA is PA + PB,
- power(RA,NPA,C)
- ;
- %% Simplification : C et A ou B sont des puissances de RC
- get_roots_add_susps(C,LRC,AddLSC),
- ((LRC \== [],
- (LRA,LRB) \== ([],[]),
- LR = [_|_],
- member((PC,RC),LRC),
- ((LR = LRA, Other = B);
- (LR = LRB, Other = A)),
- member((P,R),LR),
- R == RC)
- ->
- %% On a RC^P * Other = RC^PC
- %% si C non nul alors RC et Other (A ou B) sont non nuls
- %% => Other = RC^PO et PC = P + PO
- %% si C peut etre nul on ne peut pas reduire Other
- PO is PC - P,
- (not_unify(C,0) ->
- %% RC et Other sont non nuls
- (PO < 0 ->
- mfd:quiet_set_intervals(RC,[-1,1]),
- (PO mod 2 =:= 0 ->
- Other = 1
- ; Other = RC)
- ; %% On delegue a power
- power(RC,PO,Other))
-
- ; %% On a Other = RC^PO et RC^P * RC^PO = RC^PC
- %% On construit l union du cas C = 0 et C <> 0
- %% pour reduire RC (donc C et A ou B) et on continue.
- %% Si on a une puissance negative, RC doit etre dans -1..1
- (PO < 0 ->
- mfd:quiet_set_intervals(RC,[-1..1])
- ; (PO == 0 ->
- %% Normalement impossible PC = P => A ou B = C
- %% donc Other = 1 ou A ou B et C = 0
- true
- ; (PO == 1 ->
- mfd:get_intervals(Other,IOther),
- mfd:(RC::[0|IOther])
- ; copy_term((RC,Other),(CRC,COther)),
- mfd:dvar_remove_element(CRC,0),
- Mod2 is PO mod 2,
- %% Point fixe de power_int sur la copie
- power_int_ter(CRC,1,PO,Mod2,COther,1),
- mfd:get_intervals(CRC,IRC),
- mfd:(RC::[0|IRC])))),
- (nonvar(Other) ->
- %% Le mult peut disparaitre
- true
- ; Continue = 1))
- ;
- %% Simplification avec un mult et un power (A et B)
- ((LR = [_|_],
- LD = [_|_],
- (LR = LRB,
- LD = LDA;
- LR = LRA,
+ % Simplification : on cherche "A = C1*X" et "B = C2*X"
+ check_divisors_launch_mult_power(A,B,C,LDA,LDB,Continue1),
+ (var(Continue1) ->
+ true
+ ; get_roots_add_susps(A,LRA,_),
+ get_roots_add_susps(B,LRB,_),
+ % Simplification : on cherche "A = RA^PA", "B = RB^PB" avec RA=RB
+ ((LRB \== [],
+ member((PA,RA),LRA),
+ member((PB,RB),LRB),
+ RA == RB)
+ ->
+ % RA^PA * RA^PB = RA^(PA+PB)
+ % On delegue a power
+ NPA is PA + PB,
+ power(RA,NPA,C)
+ ;
+ % Simplification : C et A ou B sont des puissances de RC
+ get_roots_add_susps(C,LRC,AddLSC),
+ ((LRC \== [],
+ (LRA,LRB) \== ([],[]),
+ LR = [_|_],
+ member((PC,RC),LRC),
+ ((LR = LRA, Other = B);
+ (LR = LRB, Other = A)),
+ member((P,R),LR),
+ R == RC)
+ ->
+ % On a RC^P * Other = RC^PC
+ % si C non nul alors RC et Other (A ou B) sont non nuls
+ % => Other = RC^PO et PC = P + PO
+ % si C peut etre nul on ne peut pas reduire Other
+ PO is PC - P,
+ (not_unify(C,0) ->
+ % RC et Other sont non nuls
+ (PO < 0 ->
+ mfd:quiet_set_intervals(RC,[-1,1]),
+ (PO mod 2 =:= 0 ->
+ Other = 1
+ ; Other = RC)
+ ; % On delegue a power
+ power(RC,PO,Other))
+
+ ; % On a Other = RC^PO et RC^P * RC^PO = RC^PC
+ % On construit l union du cas C = 0 et C <> 0
+ % pour reduire RC (donc C et A ou B) et on continue.
+ % Si on a une puissance negative, RC doit etre dans -1..1
+ (PO < 0 ->
+ mfd:quiet_set_intervals(RC,[-1..1])
+ ; (PO == 0 ->
+ % Normalement impossible PC = P => A ou B = C
+ % donc Other = 1 ou A ou B et C = 0
+ true
+ ; (PO == 1 ->
+ mfd:get_intervals(Other,IOther),
+ mfd:(RC::[0|IOther])
+ ; copy_term((RC,Other),(CRC,COther)),
+ mfd:dvar_remove_element(CRC,0),
+ Mod2 is PO mod 2,
+ % Point fixe de power_int sur la copie
+ power_int_ter(CRC,1,PO,Mod2,COther,1),
+ mfd:get_intervals(CRC,IRC),
+ mfd:(RC::[0|IRC])))),
+ (nonvar(Other) ->
+ % Le mult peut disparaitre
+ true
+ ; Continue = 1))
+ ;
+ % Simplification avec un mult et un power (A et B)
+ ((LR = [_|_],
+ LD = [_|_],
+ (LR = LRB,
+ LD = LDA;
+ LR = LRA,
LD = LDB),
- member((Q,X),LD),
- member((P,Y),LR),
- X == Y)
- ->
- %% (Q*X)*(X^P) = C
- %% => C = Q*X^(P+1)
- P1 is P + 1,
- power(X,P1,XP1),
- no_lin_mult(Q,XP1,C)
- ;
- %% Simplification avec un add
- (nonvar(A) ->
- CoeffArg1 = A,
- Arg1 = B,
- Check = true
- ; (nonvar(B) ->
- CoeffArg1 = B,
- Arg1 = A,
- Check = true
- ; Check = fail)),
- ((member(((X,Y),Susp),AddLSC),
- ((((A,B) == (X,Y);
- (A,B) == (Y,X)),
- ABeqApB = 1);
- (Check,
- ((Arg1 == X, Arg2 = Y);
- (Arg1 == Y, Arg2 = X)))))
- ->
- %% Le add_int disparait
- kill_suspension(Susp),
- (var(ABeqApB) ->
- %% On a "CoeffArg1 * Arg1 = C" et "Arg1 + Arg2 = C"
- %% => (CoeffArg1 - 1) * Arg1 = Arg2 et "CoeffArg1 * Arg1 = C"
- %% on ajoute ainsi une congruence pour Arg2 et on oublie "Arg1 + Arg2 = C"
- NewCoeffArg is CoeffArg1 -1,
- no_lin_mult(NewCoeffArg,Arg1,Arg2),
- Continue = 1
- ; %% A * B = A + B = C, on arrete,
- %% seules solutions A=B, A: [0,2], C = 2*A = A^2
- %% le mult disparait et le add
- %% est remplace par un x2
- mfd:(A::[0,2]),true,
- protected_unify(A = B),
- no_lin_mult(2,A,C))
- ; Continue = 1))))).
+ member((Q,X),LD),
+ member((P,Y),LR),
+ X == Y)
+ ->
+ % (Q*X)*(X^P) = C
+ % => C = Q*X^(P+1)
+ P1 is P + 1,
+ power(X,P1,XP1),
+ no_lin_mult(Q,XP1,C)
+ ;
+ % Simplification avec un add
+ (nonvar(A) ->
+ CoeffArg1 = A,
+ Arg1 = B,
+ Check = true
+ ; (nonvar(B) ->
+ CoeffArg1 = B,
+ Arg1 = A,
+ Check = true
+ ; Check = fail)),
+ ((member(((X,Y),Susp),AddLSC),
+ ((((A,B) == (X,Y);
+ (A,B) == (Y,X)),
+ ABeqApB = 1);
+ (Check,
+ ((Arg1 == X, Arg2 = Y);
+ (Arg1 == Y, Arg2 = X)))))
+ ->
+ % Le add_int disparait
+ kill_suspension(Susp),
+ (var(ABeqApB) ->
+ % On a "CoeffArg1 * Arg1 = C" et "Arg1 + Arg2 = C"
+ % => (CoeffArg1 - 1) * Arg1 = Arg2 et "CoeffArg1 * Arg1 = C"
+ % on ajoute ainsi une congruence pour Arg2 et on oublie "Arg1 + Arg2 = C"
+ NewCoeffArg is CoeffArg1 -1,
+ no_lin_mult(NewCoeffArg,Arg1,Arg2),
+ Continue = 1
+ ; % A * B = A + B = C, on arrete,
+ % seules solutions A=B, A: [0,2], C = 2*A = A^2
+ % le mult disparait et le add
+ % est remplace par un x2
+ mfd:(A::[0,2]),true,
+ protected_unify(A = B),
+ no_lin_mult(2,A,C))
+ ; Continue = 1))))).
%% Simplification A = C1*X, B = C2*X et A*B=C en X^2*(C1*C2)=C
%% (generalisation de A*A -> A^2)
check_divisors_launch_mult_power(A,B,C,LDA,LDB,Continue) :-
- get_divisors(A,LDA),
- get_divisors(B,LDB),
- ((LDA \== [],
- LDB \== [],
- member((QA,OtherA),LDA),
- member((QB,OtherB),LDB),
- OtherA == OtherB)
- ->
- %% A = QA*OtherA, B = QB*OtherA
- %% et A * B = C
- %% => C = (QA*QB)*OtherA^2
- Q is QA * QB,
- (Q == 1 ->
- power(OtherA,2,C)
- ; power(OtherA,2,OtherA2),
- no_lin_mult(Q,OtherA2,C))
- ; Continue = 1).
+ get_divisors(A,LDA),
+ get_divisors(B,LDB),
+ ((LDA \== [],
+ LDB \== [],
+ member((QA,OtherA),LDA),
+ member((QB,OtherB),LDB),
+ OtherA == OtherB)
+ ->
+ % A = QA*OtherA, B = QB*OtherA
+ % et A * B = C
+ % => C = (QA*QB)*OtherA^2
+ Q is QA * QB,
+ (Q == 1 ->
+ power(OtherA,2,C)
+ ; power(OtherA,2,OtherA2),
+ no_lin_mult(Q,OtherA2,C))
+ ; Continue = 1).
%% collecte des (P,R) dans les contraintes
%% tels que R^P = Var et des add_int calculant Var
@@ -2018,7 +2019,7 @@ get_roots_add_susps(_,[],[]).
/*
check_zero_and_mult_interval(Val1,Val2,Val) :- !,
mult_interval(Val1,Val2,Val),
- congr_mult_directe(Val1,Val2,Val).
+ congr_mult_directe(int,Val1,Val2,Val).
*/
check_zero_and_mult_interval(Val1,Val2,Val) :-
(get_type(Val,_) ->
@@ -2098,7 +2099,7 @@ check_zero_and_mult_interval(Val1,Val2,Val) :-
protected_unify(Val1 = 0),
protected_unify(Val = 0))
; mult_interval(Val1,Val2,Val)))),
- congr_mult_directe(Val1,Val2,Val).
+ congr_mult_directe(int,Val1,Val2,Val).
copy_delta(A,B,CA,CB) :-
(get_deltas(A,B,S,C) ->
@@ -2547,7 +2548,7 @@ check_zero_and_div_interval_mult(Val1,Val2,Val) :-
(not_unify(Val2,0) ->
div_interval(div_mult,Val1,Val2,Val)
; true),
- congr_mult_inverse(Val1,Val2,Val).
+ congr_mult_inverse(int,Val1,Val2,Val).
%% Division intervalle par intervalle de Val1 par Val2
%% Puis intersection du domaine calcule
@@ -3305,7 +3306,7 @@ div_mod0(A, B, Q, BQ, R) :-
mfd:get_intervals(B,LInterB),
div_interval_list(div,LInterA,LInterB,LInterQ),
mfd:(Q :: LInterQ),
- congr_div_directe(A,B,Q),
+ congr_div_directe(int,A,B,Q),
% Initialisation du domaine de BQ
% mult(B,Q,BQ),
mfd:dvar_range(B,MinB,MaxB),
@@ -3313,7 +3314,7 @@ div_mod0(A, B, Q, BQ, R) :-
mult_intervals(MinB..MaxB,MinQ..MaxQ,MinBQ,MaxBQ),
interval_from_bounds(MinBQ,MaxBQ,InterBQ),
mfd:set_intervals(BQ,[InterBQ]),
- congr_mult_directe(B,Q,BQ),
+ congr_mult_directe(int,B,Q,BQ),
% Initialisation du domaine de R
% - R est borne par A et du meme signe
% - |B| > |R|
@@ -3328,8 +3329,8 @@ div_mod0(A, B, Q, BQ, R) :-
mfd:set_intervals(R,[MinR..MaxR]),
ensure_absA_lt_absB(R,B),
% minus(A,BQ,R),
- congr_mod_directe(A,B,R),
- congr_add_directe(BQ,R,A).
+ congr_mod_directe(int,A,B,R),
+ congr_add_directe(int,BQ,R,A).
div_mod_int(A, B, Q, BQ, R) :-
get_priority(Prio),
@@ -3398,7 +3399,7 @@ check_exists_div_mod_int(A,B,Q,BQ,R) :-
protected_unify(B,V2),
protected_unify(Quot,Q),
protected_unify(V2Quot,BQ),
- protected_unify(Rem,R))
+ protected_unify(RR,R))
; % issue 40: cas diviseur <> 0
% abs(X) = abs(A), abs(Y) = abs(B) =>
% abs(X // Y) = abs(A // B) et abs(X rem Y) = abs(A rem B)
@@ -4249,16 +4250,16 @@ div_mod_rec(Credit, A, SA, B, SB, Q, SQ, BQ, R, SR) :-
% Q = (B*Q) div B
div_interval(div,BQ,B,Q),
% Plus precis que congr_div_directe
- congr_mult_inverse(BQ,B,Q),
+ congr_mult_inverse(int,BQ,B,Q),
% Attention au zero de Q
% B = (B*Q) div Q
check_zero_and_div_interval(BQ,Q,B),
% Plus precis que congr_div_directe
- congr_mult_inverse(BQ,Q,B),
+ congr_mult_inverse(int,BQ,Q,B),
- congr_div_directe(A,B,Q),
- congr_mod_directe(A,B,R),
+ congr_div_directe(int,A,B,Q),
+ congr_mod_directe(int,A,B,R),
saturate_add_inequalities(A,BQ,R),
saturate_mult_inequalities(BQ,Q,B),
@@ -4308,7 +4309,7 @@ same_sign_add_interval(Val1,Val2,Val) :-
; append(Neg,Pos,BagNInter)),
list_to_intervals(integer,BagNInter,NInter),
mfd:quiet_set_intervals(Val,NInter))),
- congr_add_directe(Val1,Val2,Val).
+ congr_add_directe(int,Val1,Val2,Val).
same_sign_minus_interval(Val1,Val2,Val) :-
(integer(Val) ->
@@ -4339,7 +4340,7 @@ same_sign_minus_interval(Val1,Val2,Val) :-
; append(Neg,Pos,BagNInter)),
list_to_intervals(integer,BagNInter,NInter),
mfd:quiet_set_intervals(Val,NInter))),
- congr_add_inverse(Val1,Val2,Val).
+ congr_add_inverse(int,Val1,Val2,Val).
@@ -4419,7 +4420,7 @@ check_div_int_ineqs1([S|LSusp],Seen,NSeen,A,B,Q,R,SA,SB) :-
; ((nonvar(SA),
A == AA,
mfd:dvar_domain(A,DA),
- not mfd:in_domain(A,0))
+ not mfd:in_domain(DA,0))
->
% Q est 0 ou bien du signe de B
get_rel_between_int_args(B,BB,RB),
@@ -4630,29 +4631,29 @@ power(A,N,B) :-
power_int(A,TA,N,B,TB) :-
- get_priority(Prio),
- set_priority(1),
- power_int_bis(A,TA,N,B,TB),
- set_priority(Prio),
- wake_if_other_scheduled(Prio).
+ get_priority(Prio),
+ set_priority(1),
+ power_int_bis(A,TA,N,B,TB),
+ set_priority(Prio),
+ wake_if_other_scheduled(Prio).
power_int_bis(A,TA,N,B,TB) :-
- save_cstr_suspensions((A,B)),
- mfd:get_intervals(A,IA),
- mfd:get_intervals(B,IB),
- %% Traitement du 0
- (not_unify(A,0) ->
- mfd:dvar_remove_element(B,0)
- ; (not_unify(B,0) ->
- mfd:dvar_remove_element(A,0)
- ; true)),
- check_exists_power_int(A,N,B,Stop),
- (nonvar(Stop) ->
- true
- ; power_int_body(A,TA,N,Mod2,B,TB,Continue),
- int_check_notify_constrained(A,IA),
- int_check_notify_constrained(B,IB),
- check_before_susp_power(Continue,A,N,Mod2,B)).
+ save_cstr_suspensions((A,B)),
+ mfd:get_intervals(A,IA),
+ mfd:get_intervals(B,IB),
+ % Traitement du 0
+ (not_unify(A,0) ->
+ mfd:dvar_remove_element(B,0)
+ ; (not_unify(B,0) ->
+ mfd:dvar_remove_element(A,0)
+ ; true)),
+ check_exists_power_int(A,N,B,Stop),
+ (nonvar(Stop) ->
+ true
+ ; power_int_body(A,TA,N,Mod2,B,TB,Continue),
+ int_check_notify_constrained(A,IA),
+ int_check_notify_constrained(B,IB),
+ check_before_susp_power(Continue,A,N,Mod2,B)).
power_int_body(A,TA,N,Mod2,B,TB,Continue) :-
Mod2 is N mod 2,
@@ -4669,7 +4670,7 @@ power_int_body(A,TA,N,Mod2,B,TB,Continue) :-
% Projections des congruences,
% le point fixe est necessaire et peut
% aller jusqu'a instancier A et B
- fp_congr_power(A,N,B),
+ fp_congr_power(int,A,N,B),
power_inst(A,N,Mod2,B,Continue0),
(var(Continue0) ->
true
@@ -4840,7 +4841,7 @@ power_int_ter(_,_,_,_,_,_).
power_int_direct(A,N,Mod2,B,TB) :-
- congr_power_directe(A,N,B),
+ congr_power_directe(int,A,N,B),
%% Calcul de B a partir de A
mfd:get_intervals(A,LInterA),
power_interval_list(LInterA,N,Mod2,LInter),
@@ -4852,7 +4853,7 @@ power_int_direct(A,N,Mod2,B,TB) :-
power_int_inverse(B,A,N,Mod2,TA) :-
- congr_power_inverse(B,N,A),
+ congr_power_inverse(int,B,N,A),
%% Calcul de A a partir de B
mfd:get_intervals(B,LInterB),
get_congr(A,CA,MA),
@@ -4866,150 +4867,148 @@ power_int_inverse(B,A,N,Mod2,TA) :-
check_exists_power_int(A,N,B,Stop) :-
- get_saved_cstr_suspensions(LSusp),
- LSusp = [_|_],!,
- mfd:dvar_range(A,MinA,MaxA),
- ((MinA >= -1,
- MaxA =< 1)
- ->
- AbsLowerOne = 1,
- Mod2 is N mod 2
- ; true),
- check_exists_power_int_A(LSusp,A,N,AbsLowerOne,Mod2,B,Stop),
- (var(Stop) ->
- check_exists_power_int_B(LSusp,A,N,B)
- ; true).
+ get_saved_cstr_suspensions(LSusp),
+ LSusp = [_|_],!,
+ mfd:dvar_range(A,MinA,MaxA),
+ ((MinA >= -1,
+ MaxA =< 1)
+ ->
+ AbsLowerOne = 1,
+ Mod2 is N mod 2
+ ; true),
+ check_exists_power_int_A(LSusp,A,N,AbsLowerOne,Mod2,B,Stop),
+ (var(Stop) ->
+ check_exists_power_int_B(LSusp,A,N,B)
+ ; true).
check_exists_power_int(A,N,B,Stop).
check_exists_power_int_A([],_,_,_,_,_,_).
check_exists_power_int_A([(Susp,Goal)|LS],A,N,AbsLowerOne,Mod2,B,Stop) :-
- (Goal = power_int(X,_,P,Y,_) ->
- (X == A ->
- ((N == P;
- (nonvar(AbsLowerOne),
- P mod 2 =:= Mod2))
- ->
- %% X == A et N = P ou |A| =< 1 avec meme parite pour N et P
- %% => X^P = A^N
- kill_suspension(Susp),
- protected_unify(B = Y)
- ; (Y == B ->
- %%
- Stop = 1,
- kill_suspension(Susp),
- %% A^N = A^P avec N <> P (instancies tous les deux)
- %% alors A dans [-1..1]
- mfd:quiet_set_intervals(A,[-1..1]),
- Parity is (N mod 2) + (P mod 2),
- (Parity == 0 ->
- mfd:quiet_set_intervals(B,[0,1]),
- %% N et P pairs on |A| = B
- abs_val_int_bis(A,B)
- ; (Parity == 1 ->
- %% pair et impair: donc B et A <> -1 et A = B
- mfd:quiet_set_intervals(B,[0,1]),
- protected_unify(A = B)
- ; %% N et P impairs donc A = B
- protected_unify(A = B)))
- ; check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)))
- ; (Y == A ->
- %% On a A^N = B et X^P = A
- %% -> X^P = A et X^(N*P) = B
- Stop = 1,
- NP is N * P,
- power_int_bis(X,1,NP,B,1)
- ; check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)))
- ; ((Goal = mult_int(X,_,Y,_,CB,_),
- CB == B,
- (A == X, V = Y; %% A^N=B et A*Y=B
- A == Y, V = X)) %% A^N=B et X*A=B
- ->
- %% A^N = A*V = B
- %% Si A <> 0 alors A^(N-1) = V el le mult disparait
- PN is N - 1,
- (not_unify(A,0) ->
- kill_suspension(Susp),
- %% On peut reduire A et V
- %% le mult est remplace par un power
- power(A,PN,V)
- ; %% On retire 0 de la copie de A pour reduire sa partie non nulle
- %% et on intersecte A avec l'union de 0 et de la reduction de CA
- copy_term(A,CA),
- mfd:dvar_remove_element(CA,0),
- copy_term(V,CV),
- PMod2 is PN mod 2,
- power_int_ter(CA,1,PN,PMod2,CV,1),
- mfd:get_intervals(CA,ICA),
- mfd:(A::[0|ICA]),
- (number(V) ->
- %% Le mult peut disparaitre
- kill_suspension(Susp)
- ; true))
- ; true),
- check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)).
+ (Goal = power_int(X,_,P,Y,_) ->
+ (X == A ->
+ ((N == P;
+ (nonvar(AbsLowerOne),
+ P mod 2 =:= Mod2))
+ ->
+ % X == A et N = P ou |A| =< 1 avec meme parite pour N et P
+ % => X^P = A^N
+ kill_suspension(Susp),
+ protected_unify(B = Y)
+ ; (Y == B ->
+ Stop = 1,
+ kill_suspension(Susp),
+ % A^N = A^P avec N <> P (instancies tous les deux)
+ % alors A dans [-1..1]
+ mfd:quiet_set_intervals(A,[-1..1]),
+ Parity is (N mod 2) + (P mod 2),
+ (Parity == 0 ->
+ mfd:quiet_set_intervals(B,[0,1]),
+ % N et P pairs on |A| = B
+ abs_val_int_bis(A,B)
+ ; (Parity == 1 ->
+ % pair et impair: donc B et A <> -1 et A = B
+ mfd:quiet_set_intervals(B,[0,1]),
+ protected_unify(A = B)
+ ; % N et P impairs donc A = B
+ protected_unify(A = B)))
+ ; check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)))
+ ; (Y == A ->
+ % On a A^N = B et X^P = A
+ % -> X^P = A et X^(N*P) = B
+ Stop = 1,
+ NP is N * P,
+ power_int_bis(X,1,NP,B,1)
+ ; check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)))
+ ; ((Goal = mult_int(X,_,Y,_,CB,_),
+ CB == B,
+ (A == X, V = Y; %% A^N=B et A*Y=B
+ A == Y, V = X)) %% A^N=B et X*A=B
+ ->
+ % A^N = A*V = B
+ % Si A <> 0 alors A^(N-1) = V el le mult disparait
+ PN is N - 1,
+ (not_unify(A,0) ->
+ kill_suspension(Susp),
+ % On peut reduire A et V
+ % le mult est remplace par un power
+ power(A,PN,V)
+ ; % On retire 0 de la copie de A pour reduire sa partie non nulle
+ % et on intersecte A avec l'union de 0 et de la reduction de CA
+ copy_term(A,CA),
+ mfd:dvar_remove_element(CA,0),
+ copy_term(V,CV),
+ PMod2 is PN mod 2,
+ power_int_ter(CA,1,PN,PMod2,CV,1),
+ mfd:get_intervals(CA,ICA),
+ mfd:(A::[0|ICA]),
+ (number(V) ->
+ % Le mult peut disparaitre
+ kill_suspension(Susp)
+ ; true))
+ ; true),
+ check_exists_power_int_A(LS,A,N,AbsLowerOne,Mod2,B,Stop)).
check_exists_power_int_B([],_,_,_).
check_exists_power_int_B([(Susp,Goal)|LS],A,N,B) :-
- (Goal = power_int(X,_,P,Y,_) ->
- ((Y == B,
- N == P)
- ->
- (P mod 2 =:= 1 ->
- %% Seules les puissances impaires sont inversibles directement
- kill_suspension(Susp),
- protected_unify(X = A)
- ; %% Puissance paire
- %% si A et X signes on peut deduire X = A ou X = -A
- ((get_sign(A,SA),
- get_sign(X,SX))
- ->
- kill_suspension(Susp),
- (SA == SX ->
- protected_unify(X = A)
- ; %% On ajoute l'info X = -A
- op(X,A))
- ; Continue = 1))
- ; Continue = 1),
- (nonvar(Continue) ->
- check_exists_power_int_B(LS,A,N,B)
- ; (X == B ->
- %% On a A^N = B et B^P = Y
- %% -> A^(N*P) = Y et A^N = B
- kill_suspension(Susp),
- NP is N * P,
- power_int_bis(A,1,NP,Y,1)
- ; check_exists_power_int_B(LS,A,N,B)))
- ; check_exists_power_int_B(LS,A,N,B)).
+ (Goal = power_int(X,_,P,Y,_) ->
+ ((Y == B,
+ N == P)
+ ->
+ (P mod 2 =:= 1 ->
+ % Seules les puissances impaires sont inversibles directement
+ kill_suspension(Susp),
+ protected_unify(X = A)
+ ; % Puissance paire
+ % si A et X signes on peut deduire X = A ou X = -A
+ ((get_sign(A,SA),
+ get_sign(X,SX))
+ ->
+ kill_suspension(Susp),
+ (SA == SX ->
+ protected_unify(X = A)
+ ; % On ajoute l'info X = -A
+ op(X,A))
+ ; Continue = 1))
+ ; Continue = 1),
+ (nonvar(Continue) ->
+ check_exists_power_int_B(LS,A,N,B)
+ ; (X == B ->
+ % On a A^N = B et B^P = Y
+ % -> A^(N*P) = Y et A^N = B
+ kill_suspension(Susp),
+ NP is N * P,
+ power_int_bis(A,1,NP,Y,1)
+ ; check_exists_power_int_B(LS,A,N,B)))
+ ; check_exists_power_int_B(LS,A,N,B)).
check_before_susp_power(Continue,A,N,Mod2,B) :-
- var(Continue),!.
+ var(Continue),!.
check_before_susp_power(Continue,A,N,Mod2,B) :-
-
my_suspend(power_int(A,_,N,B,_),4,(A,B)->suspend:constrained).
root_interval_list(LIV,N,Parity,CB,MB,CA,MA,Res,NLIV) :-
- (MA \== 1 ->
- % congruences pour le calcul des racines negatives
- NCA is (-CA) mod MA,
- congr_power_directe(NCA,MA,N,OpCB0,OpMB),
- OpCB is OpCB0 mod OpMB,
- (inter_congr(OpCB,CB,OpMB,MB,NCB,NMB) ->
- true
- ; NCB = OpCB,
- NMB = OpMB)
- ; NCB = 0,
- NMB = 1,
- NCA = 0),
- (N == 2 ->
- get_Div_from_congr(N,CB,MB,CA,MA,DivP),
- ((CB,MB,CA) == (NCB,NMB,NCA) ->
- DivN = DivP
- ; get_Div_from_congr(N,NCB,NMB,NCA,MA,DivN))
- ; DivP = DivN),
- root_interval_list(LIV,N,Parity,CB,MB,NCB,NMB,CA,MA,NCA,DivP,DivN,Res0,NLIV0),
- list_to_intervals(integer,Res0,Res),
- list_to_intervals(integer,NLIV0,NLIV).
+ (MA \== 1 ->
+ % congruences pour le calcul des racines negatives
+ NCA is (-CA) mod MA,
+ congr_power_directe(NCA,MA,N,OpCB0,OpMB),
+ OpCB is OpCB0 mod OpMB,
+ (inter_congr(OpCB,CB,OpMB,MB,NCB,NMB) ->
+ true
+ ; NCB = OpCB,
+ NMB = OpMB)
+ ; NCB = 0,
+ NMB = 1,
+ NCA = 0),
+ (N == 2 ->
+ get_Div_from_congr(N,CB,MB,CA,MA,DivP),
+ ((CB,MB,CA) == (NCB,NMB,NCA) ->
+ DivN = DivP
+ ; get_Div_from_congr(N,NCB,NMB,NCA,MA,DivN))
+ ; DivP = DivN),
+ root_interval_list(LIV,N,Parity,CB,MB,NCB,NMB,CA,MA,NCA,DivP,DivN,Res0,NLIV0),
+ list_to_intervals(integer,Res0,Res),
+ list_to_intervals(integer,NLIV0,NLIV).
% On peut travailler mieux si N = 2 et parite connue
% B = A^2 avec B = CB + Kb*MB et A = CA + Ka*MA
@@ -5557,102 +5556,104 @@ check_before_susp_abs_val(Val,Abs) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff_bool(A,B) :-
- set_lazy_domain(bool,A),
- set_lazy_domain(bool,B),
- A \== B,
- check_delta_diff_bool(A,B,Continue),
- (var(Continue) ->
- true
- ; check_exists_diff_bool(A,B),
- launch_delta(A,B,'#',-1..1),
- diff_bool2(A,B)).
+ set_lazy_domain(bool,A),
+ set_lazy_domain(bool,B),
+ A \== B,
+ check_delta_diff_bool(A,B,Continue),
+ (var(Continue) ->
+ true
+ ; check_exists_diff_bool(A,B),
+ launch_delta(A,B,'#',-1..1),
+ diff_bool2(A,B)).
diff_bool2(A,B) :-
- (var(A) ->
- (var(B) ->
- Prio = 2,
- my_suspend(diff_bool(A,B), Prio, (A,B) -> suspend:bound)
- ; (B == t ->
- protected_unify(A = f)
- ; %% B == f
- protected_unify(A = t)))
- ; (A == t ->
- protected_unify(B = f)
- ; %% A == f
- protected_unify(B = t))).
+ (var(A) ->
+ (var(B) ->
+ Prio = 2,
+ my_suspend(diff_bool(A,B), Prio, (A,B) -> suspend:bound)
+ ; (B == t ->
+ protected_unify(A = f)
+ ; % B == f
+ protected_unify(A = t)))
+ ; (A == t ->
+ protected_unify(B = f)
+ ; % A == f
+ protected_unify(B = t))).
%% Si on a un autre diff avec C a partir de
%% A ou B alors il est egal a B ou A
check_delta_diff_bool(A,B,Continue) :-
- var(A),
- var(B),!,
- ((ndelta:get_delta_before_after(A,BA,AA),
- (DA = BA; DA = AA),
- member((X,'#',_),DA),
- X \== B)
- ->
- protected_unify(X = B)
- ; ((ndelta:get_delta_before_after(B,BB,AB),
- (DB = BB; DB = AB),
- member((X,'#',_),DB),
- X \== A)
- ->
- protected_unify(X = A)
- ; Continue = 1)).
+ var(A),
+ var(B),
+ getval(use_delta,1)@eclipse,
+ !,
+ ((ndelta:get_delta_before_after(A,BA,AA),
+ (DA = BA; DA = AA),
+ member((X,'#',_),DA),
+ X \== B)
+ ->
+ protected_unify(X = B)
+ ; ((ndelta:get_delta_before_after(B,BB,AB),
+ (DB = BB; DB = AB),
+ member((X,'#',_),DB),
+ X \== A)
+ ->
+ protected_unify(X = A)
+ ; Continue = 1)).
check_delta_diff_bool(_,_,1).
check_exists_diff_bool(A,B) :-
- ((var(A),
- get_bound_suspensions(A,LSusp),
- member(Susp,LSusp),
- get_suspension_data(Susp,goal,diff_bool(X,Y)),
- ((X,Y) == (A,B);
- (X,Y) == (B,A)))
- ->
- kill_suspension(Susp)
- ; true).
+ ((var(A),
+ get_bound_suspensions(A,LSusp),
+ member(Susp,LSusp),
+ get_suspension_data(Susp,goal,diff_bool(X,Y)),
+ ((X,Y) == (A,B);
+ (X,Y) == (B,A)))
+ ->
+ kill_suspension(Susp)
+ ; true).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff_enum(A,B) :-
- A \== B,
- %% Pas de domaine par defaut
- ((two_value_domain(A,Dom),
- two_value_domain(B,Dom))
- ->
- check_delta_diff_bool(A,B,Continue)
- ; Continue = 1),
- (var(Continue) ->
- true
- ; check_exists_diff_enum(A,B),
- launch_delta(A,B,'#',-1..1),
- diff_enum2(A,B)).
+ A \== B,
+ % Pas de domaine par defaut
+ ((two_value_domain(A,Dom),
+ two_value_domain(B,Dom))
+ ->
+ check_delta_diff_bool(A,B,Continue)
+ ; Continue = 1),
+ (var(Continue) ->
+ true
+ ; check_exists_diff_enum(A,B),
+ launch_delta(A,B,'#',-1..1),
+ diff_enum2(A,B)).
diff_enum2(A,B) :-
- (var(A) ->
- is_fd_domain(A),
- (var(B) ->
- is_fd_domain(A),
- (not_unify(A,B) ->
- true
- ; Prio = 2,
- my_suspend(diff_enum(A,B), Prio, (A,B) -> suspend:bound))
- ; mfd:dvar_remove_element(A,B))
- ; mfd:dvar_remove_element(B,A)).
+ (var(A) ->
+ is_fd_domain(A),
+ (var(B) ->
+ is_fd_domain(A),
+ (not_unify(A,B) ->
+ true
+ ; Prio = 2,
+ my_suspend(diff_enum(A,B), Prio, (A,B) -> suspend:bound))
+ ; mfd:dvar_remove_element(A,B))
+ ; mfd:dvar_remove_element(B,A)).
check_exists_diff_enum(A,B) :-
- ((var(A),
- get_bound_suspensions(A,LSusp),
- member(Susp,LSusp),
- get_suspension_data(Susp,goal,diff_enum(X,Y)),
- ((X,Y) == (A,B);
- (X,Y) == (B,A)))
- ->
- kill_suspension(Susp)
- ; true).
+ ((var(A),
+ get_bound_suspensions(A,LSusp),
+ member(Susp,LSusp),
+ get_suspension_data(Susp,goal,diff_enum(X,Y)),
+ ((X,Y) == (A,B);
+ (X,Y) == (B,A)))
+ ->
+ kill_suspension(Susp)
+ ; true).
@@ -5849,46 +5850,46 @@ refute_diff_with_gt_lt(A,B,Stop).
%% et/ou les congruences incompatibles
%% On n'utilise pas not_unify car on pourrait avoir un #
check_diff_interval_congr(A,B,Continue) :-
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- (inter_congr(CA,CB,MA,MB,C,M) ->
- mfd:get_intervals(A,IA),
- mfd:get_intervals(B,IB),
- intervals_intersection(integer,IA,IB,Inter),
- reduce_congr_bounds_interval_list(Inter,C,M,NInter),
- (NInter == [] ->
- %% pas d'element commun
- true
- ; Continue = 1)
- ; %% congruences incompatibles
- true).
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ (inter_congr(CA,CB,MA,MB,C,M) ->
+ mfd:get_intervals(A,IA),
+ mfd:get_intervals(B,IB),
+ intervals_intersection(integer,IA,IB,Inter),
+ reduce_congr_bounds_interval_list(Inter,C,M,NInter),
+ (NInter == [] ->
+ % pas d'element commun
+ true
+ ; Continue = 1)
+ ; % congruences incompatibles
+ true).
launch_geq(A, B) :-
- set_lazy_domain(int,A),
+ set_lazy_domain(int,A),
set_lazy_domain(int,B),
(A == B ->
- true
- ; (ndelta:exists_delta_Rel(A,B,Rel,_,_) ->
- Rel \== '<',
- (Rel == '=<' ->
- protected_unify(A = B)
- ; (occurs(Rel,('#','>')) ->
- launch_gt(A,B)
- ; % on doit lancer le geq si il n existe pas
- ((suspensions(A,LS),
- member(S,LS),
- get_suspension_data(S,goal,geq(X,Y)),
- (X,Y) == (A,B))
- ->
- %% Le geq est deja gere
- true
- ; lin_geq_int(A,B),
- geq(A,B))))
- ; lin_geq_int(A,B),
- geq(A,B))).
+ true
+ ; (ndelta:exists_delta_Rel(A,B,Rel,_,_) ->
+ Rel \== '<',
+ (Rel == '=<' ->
+ protected_unify(A = B)
+ ; (occurs(Rel,('#','>')) ->
+ launch_gt(A,B)
+ ; % on doit lancer le geq si il n existe pas
+ ((suspensions(A,LS),
+ member(S,LS),
+ get_suspension_data(S,goal,geq(X,Y)),
+ (X,Y) == (A,B))
+ ->
+ % Le geq est deja gere
+ true
+ ; lin_geq_int(A,B),
+ geq(A,B))))
+ ; lin_geq_int(A,B),
+ geq(A,B))).
geq(A, B) :-
@@ -5991,7 +5992,8 @@ launch_delta_leq_lt(+,Inter,A,B) :-
:- export update_delta_cost_with_congr/6.
%update_delta_cost_with_congr(X,Y,S,C,S,C) :- !.
update_delta_cost_with_congr(X,Y,S,C,NS,NC) :-
- ((exists_congr(X,CX,MX),
+ ((get_type(X,int), % pas encore pour les real_int
+ exists_congr(X,CX,MX),
exists_congr(Y,CY,MY),
MDV is gcd(MX,MY),
MDV > 1)
@@ -6177,8 +6179,8 @@ leq(A,B) :-
min_int_interval(A,A,C) ?- !,
protected_unify(A,C).
min_int_interval(A,B,C) :-
- set_lazy_domain(int,A),
- set_lazy_domain(int,B),
+ set_lazy_domain(int,A),
+ set_lazy_domain(int,B),
mfd:dvar_range(A,LA,HA),
mfd:dvar_range(B,LB,HB),
(HA =< LB ->
@@ -6190,110 +6192,116 @@ min_int_interval(A,B,C) :-
set_intervals(int,C,[LC..HC]))).
min_int(A,B,C) :-
- set_lazy_domain(int,A),
- set_lazy_domain(int,B),
- get_priority(Prio),
- set_priority(1),
- min_bis(A,B,C),
- set_priority(Prio),
- wake_if_other_scheduled(Prio).
+ set_lazy_domain(int,A),
+ set_lazy_domain(int,B),
+ get_priority(Prio),
+ set_priority(1),
+ min_bis(A,B,C),
+ set_priority(Prio),
+ wake_if_other_scheduled(Prio).
min_bis(A,B,C) :-
- save_cstr_suspensions((A,B)),
- %% Factorisation
- check_exists_min_int(A,B,C),
- mfd:dvar_domain(A,DomA),
- mfd:dvar_domain(B,DomB),
- mfd:dom_union(DomA,DomB,dom(IC)),
- %% Et les congruences sur A et B ??
- mfd:quiet_set_intervals(C,IC),
- mfd:maxdomain(A,MaxA),
- mfd:maxdomain(B,MaxB),
- MaxC is min(MaxA,MaxB),
- mfd:dvar_remove_greater(C,MaxC),
- mfd:mindomain(C,MinC),
- mfd:dvar_remove_smaller(A,MinC),
- mfd:dvar_remove_smaller(B,MinC),
- %% C =< A et C =< B
- launch_delta_leq(C,A),
- launch_delta_leq(C,B),
- min_free_inst(A,B,C,Continue),
- (nonvar(Continue) ->
- set_prio_inst([A,B,C],3,4,Prio),
-
+ save_cstr_suspensions((A,B)),
+ % Factorisation
+ check_exists_min_int(A,B,C),
+ mfd:dvar_domain(A,DomA),
+ mfd:dvar_domain(B,DomB),
+ mfd:dom_union(DomA,DomB,dom(IC)),
+ mfd:quiet_set_intervals(C,IC),
+ mfd:maxdomain(A,MaxA),
+ mfd:maxdomain(B,MaxB),
+ MaxC is min(MaxA,MaxB),
+ mfd:dvar_remove_greater(C,MaxC),
+ mfd:mindomain(C,MinC),
+ mfd:dvar_remove_smaller(A,MinC),
+ mfd:dvar_remove_smaller(B,MinC),
+ % C =< A et C =< B
+ launch_delta_leq(C,A),
+ launch_delta_leq(C,B),
+ % congruences sur A et B
+ ((exists_congr(A,CA,MA),
+ exists_congr(B,CB,MB))
+ ->
+ union_congr(CA,CB,MA,MB,CC,MC,_),
+ launch_congr(C,CC,MC)
+ ; true),
+ min_free_inst(A,B,C,Continue),
+ (nonvar(Continue) ->
+ set_prio_inst([A,B,C],3,4,Prio),
+
my_suspend(min_int(A,B,C),Prio,(A,B,C) -> suspend:constrained)
- ; true).
+ ; true).
min_free_inst(A,B,C,Continue) :-
- ( A == B ->
- protected_unify(C = A)
- ; (A == C ->
- lin_geq_int(B,A),
+ ( A == B ->
+ protected_unify(C = A)
+ ; (A == C ->
+ lin_geq_int(B,A),
geq(B,A)
- ; (B == C ->
- lin_geq_int(A,B),
- geq(A,B)
- ; (exists_diff_Rel(C,A) ->
- protected_unify(C = B),
- lin_gt_int(A,B),
- gt(A,B)
- ; (exists_diff_Rel(C,B) ->
- protected_unify(C = A),
- lin_gt_int(B,A),
- gt(B,A)
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- (MaxA =< MinB ->
- protected_unify(C = A)
- ; (MaxB =< MinA ->
- protected_unify(C = B)
- ; (ndelta:exists_delta_Rel(A,B,Rel,_,_) ->
- (occurs(Rel,('<','=<')) ->
- protected_unify(C = A)
- ; (occurs(Rel,('>','>=')) ->
- protected_unify(C = B)
- ; min_two_value_domain(A,B,C,Continue)))
- ; min_two_value_domain(A,B,C,Continue))))))))).
+ ; (B == C ->
+ lin_geq_int(A,B),
+ geq(A,B)
+ ; (exists_diff_Rel(C,A) ->
+ protected_unify(C = B),
+ lin_gt_int(A,B),
+ gt(A,B)
+ ; (exists_diff_Rel(C,B) ->
+ protected_unify(C = A),
+ lin_gt_int(B,A),
+ gt(B,A)
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ (MaxA =< MinB ->
+ protected_unify(C = A)
+ ; (MaxB =< MinA ->
+ protected_unify(C = B)
+ ; (ndelta:exists_delta_Rel(A,B,Rel,_,_) ->
+ (occurs(Rel,('<','=<')) ->
+ protected_unify(C = A)
+ ; (occurs(Rel,('>','>=')) ->
+ protected_unify(C = B)
+ ; min_two_value_domain(A,B,C,Continue)))
+ ; min_two_value_domain(A,B,C,Continue))))))))).
min_two_value_domain(A,B,C,Continue) :-
- ((two_value_domain(A,Dom),
- two_value_domain(B,Dom))
- ->
- (exists_diff_Rel(A,B) ->
- mfd:mindomain(A,MinA),
- MinA = C
- ; ((integer(C),
- exists_max_int(A,B,Max,Susp),
- integer(Max))
- ->
- %% A priori Max > C
- %% On remplace mint_int et max_int
- %% par diff_int
- kill_suspension(Susp),
- mfd:mindomain(A,MinA),
- MinA = C,
- launch_diff_int(A,B)
- ; Continue = 1))
- ; Continue = 1).
+ ((two_value_domain(A,Dom),
+ two_value_domain(B,Dom))
+ ->
+ (exists_diff_Rel(A,B) ->
+ mfd:mindomain(A,MinA),
+ MinA = C
+ ; ((integer(C),
+ exists_max_int(A,B,Max,Susp),
+ integer(Max))
+ ->
+ % A priori Max > C
+ % On remplace mint_int et max_int
+ % par diff_int
+ kill_suspension(Susp),
+ mfd:mindomain(A,MinA),
+ MinA = C,
+ launch_diff_int(A,B)
+ ; Continue = 1))
+ ; Continue = 1).
check_exists_min_int(A,B,C) :-
- (exists_min_int(A,B,Min,Susp) ->
- kill_suspension(Susp),
- protected_unify(C = Min)
- ; true).
+ (exists_min_int(A,B,Min,Susp) ->
+ kill_suspension(Susp),
+ protected_unify(C = Min)
+ ; true).
exists_min_int(A,B,Min,Susp) :-
- get_saved_cstr_suspensions((A,B)),
- member((Susp,min_int(X,Y,Min)),LSusp),
- ((X,Y) == (A,B)
- ;(Y,X) == (A,B)),!.
+ get_saved_cstr_suspensions((A,B)),
+ member((Susp,min_int(X,Y,Min)),LSusp),
+ ((X,Y) == (A,B)
+ ;(Y,X) == (A,B)),!.
check_before_susp_min_int(A,B,C) :-
- min_free_inst(A,B,C,Continue),
- (var(Continue) ->
- true
- ; set_prio_inst([A,B,C],3,4,Prio),
-
+ min_free_inst(A,B,C,Continue),
+ (var(Continue) ->
+ true
+ ; set_prio_inst([A,B,C],3,4,Prio),
+
my_suspend(min_int(A,B,C),Prio,(A,B,C) -> suspend:constrained)).
@@ -6325,32 +6333,38 @@ max_int(A,B,C) :-
wake_if_other_scheduled(Prio).
max_bis(A,B,C) :-
- save_cstr_suspensions((A,B)),
- %% Factorisation
- check_exists_max_int(A,B,C),
- mfd:dvar_domain(A,DomA),
- mfd:dvar_domain(B,DomB),
- mfd:dom_union(DomA,DomB,dom(IC)),
- %% Et les congruences sur A et B ??
- mfd:quiet_set_intervals(C,IC),
-
- mfd:mindomain(A,MinA),
- mfd:mindomain(B,MinB),
- MinC is max(MinA,MinB),
- mfd:dvar_remove_smaller(C,MinC),
-
- mfd:maxdomain(C,MaxC),
- mfd:dvar_remove_greater(A,MaxC),
- mfd:dvar_remove_greater(B,MaxC),
- %% C >= A et C >= B
- launch_delta_leq(A,C),
- launch_delta_leq(B,C),
- max_free_inst(A,B,C,Continue),
- (nonvar(Continue) ->
- set_prio_inst([A,B,C],3,4,Prio),
-
+ save_cstr_suspensions((A,B)),
+ % Factorisation
+ check_exists_max_int(A,B,C),
+ mfd:dvar_domain(A,DomA),
+ mfd:dvar_domain(B,DomB),
+ mfd:dom_union(DomA,DomB,dom(IC)),
+ mfd:quiet_set_intervals(C,IC),
+
+ mfd:mindomain(A,MinA),
+ mfd:mindomain(B,MinB),
+ MinC is max(MinA,MinB),
+ mfd:dvar_remove_smaller(C,MinC),
+
+ mfd:maxdomain(C,MaxC),
+ mfd:dvar_remove_greater(A,MaxC),
+ mfd:dvar_remove_greater(B,MaxC),
+ % C >= A et C >= B
+ launch_delta_leq(A,C),
+ launch_delta_leq(B,C),
+ % congruences sur A et B
+ ((exists_congr(A,CA,MA),
+ exists_congr(B,CB,MB))
+ ->
+ union_congr(CA,CB,MA,MB,CC,MC,_),
+ launch_congr(C,CC,MC)
+ ; true),
+ max_free_inst(A,B,C,Continue),
+ (nonvar(Continue) ->
+ set_prio_inst([A,B,C],3,4,Prio),
+
my_suspend(max_int(A,B,C),Prio,(A,B,C) -> suspend:constrained)
- ; true).
+ ; true).
max_free_inst(A,B,C,Continue) :-
( A == B ->
@@ -6564,75 +6578,88 @@ check_fusion_div_mod(A,B,Q) :-
; true).
check_fusion_mult(A,B,C) :-
- check_fusion_goal(A,B,C,mult_int(X,_,Y,_,Z,_),X,Y,Z).
+ check_fusion_goal(A,B,C,mult_int(X,_,Y,_,Z,_),X,Y,Z).
check_fusion_add(A,B,C) :-
- check_fusion_goal(A,B,C,add_int(X,_,Y,_,Z,_),X,Y,Z).
+ check_fusion_goal(A,B,C,add_int(X,_,Y,_,Z,_),X,Y,Z).
%% Fusion si 2 sur 3 arguments sont egaux (pour + et *)
%% modulo la commutativite des 2 premiers
check_fusion_goal(A,B,C,Goal,X,Y,Z) :-
- get_saved_cstr_suspensions(LSusp),
- ((member((_,Goal),LSusp),
- ((A == X,
- ((B == Y, U1 = C, U2 = Z)
- ;(C == Z, U1 = B, U2 = Y)))
- ;(A == Y,
- ((B == X, U1 = C, U2 = Z)
- ;(C == Z, U1 = B, U2 = X)))
- ;(C == Z,
- ((B == X, U1 = A, U2 = Y)
- ;(B == Y, U1 = A, U2 = X)))))
- ->
- protected_unify(U1 = U2)
- ; true).
+ get_saved_cstr_suspensions(LSusp),
+ functor(Goal,F,_),
+ ((member((_,Goal),LSusp),
+ (A == X ->
+ (B == Y ->
+ U1 = C, U2 = Z
+ ; not_null_mult_res(F,C),
+ C == Z,
+ U1 = B, U2 = Y)
+ ; (A == Y ->
+ (B == X ->
+ U1 = C, U2 = Z
+ ; not_null_mult_res(F,C),
+ C == Z,
+ U1 = B, U2 = X)
+ ; not_null_mult_res(F,C),
+ C == Z,
+ (B == X ->
+ U1 = A, U2 = Y
+ ; B == Y,
+ U1 = A, U2 = X))))
+ ->
+ protected_unify(U1,U2)
+ ; true).
+not_null_mult_res(mult_int,R) ?- !,
+ not_unify(R,0).
+not_null_mult_res(_,_).
%% Factorisation avec un div_mod_int
%% a partir d'un add ou d'un mult
check_fusion_div_mod_int(Op,X,Y,Z) :-
- %% Au moins deux variables
- (term_variables((X,Y,Z),[_,_|_]) ->
- check_fusion_div_mod_int1(Op,X,Y,Z)
- ; true).
+ % Au moins deux variables
+ (term_variables((X,Y,Z),[_,_|_]) ->
+ check_fusion_div_mod_int1(Op,X,Y,Z)
+ ; true).
%% On est sur un add(X,Y,XpY)
%% On regarde si on trouve un div_mod_int "factorisable"
check_fusion_div_mod_int1(add_int,X,Y,XpY) :-
- %% les projections inverses de add sont des fonctions
- check_fusion_goal(X,Y,XpY,div_mod_int(A,_,_,BQ,R),BQ,R,A).
+ % les projections inverses de add sont des fonctions
+ check_fusion_goal(X,Y,XpY,div_mod_int(A,_,_,BQ,R),BQ,R,A).
%% On est sur un mult(X,Y,XY)
%% On regarde si on trouve un div_mod_int "factorisable"
check_fusion_div_mod_int1(mult_int,X,Y,XY) :-
- %% On regarde si on peut fusionner un div_mod_int sur le calcul de X*Y
- (not_unify(XY,0) ->
- %% XY, X et Y <> 0, les projections inverses de mult sont
- %% des fonctions
- %% si on a un div_mod_int(_,B,Q,BQ,_) avec identites
- %% entre 2 sur trois parmis (X,Y,XY) et 2 sur trois parmis (B,Q,BQ)
- %% alors on peut unifier les autres arguments
- check_fusion_goal(X,Y,XY,div_mod_int(_,B,Q,BQ,_),B,Q,BQ)
- ; %% on ne peut pas utiliser XY pour faire le matching
- get_saved_cstr_suspensions(LSusp),
- ((member((_,div_mod_int(_,B,Q,BQ,_)),LSusp),
- ((X,Y) == (B,Q); (X,Y) == (Q,B)))
- ->
- protected_unify(XY = BQ)
- ; true)),
- %% On regarde si B divise A dans un div_mod_int
- get_saved_cstr_suspensions(LSusp),
- ((member((Susp,div_mod_int(A,B,Q,BQ,R)),LSusp),
- A == XY,
- (B == X; %% X=B<>0 divise A donc R = 0
- B == Y)) %% Y=B<>0 divise A donc R = 0
- ->
- %% Le div_mod_int devient un mult
- kill_suspension(Susp),
- protected_unify(R = 0),
- protected_unify(BQ = A),
- call_priority(mult(B,Q,A),4)
- ; true).
+ % On regarde si on peut fusionner un div_mod_int sur le calcul de X*Y
+ (not_unify(XY,0) ->
+ % XY, X et Y <> 0, les projections inverses de mult sont
+ % des fonctions
+ % si on a un div_mod_int(_,B,Q,BQ,_) avec identites
+ % entre 2 sur trois parmis (X,Y,XY) et 2 sur trois parmis (B,Q,BQ)
+ % alors on peut unifier les autres arguments
+ check_fusion_goal(X,Y,XY,div_mod_int(_,B,Q,BQ,_),B,Q,BQ)
+ ; % on ne peut pas utiliser XY pour faire le matching
+ get_saved_cstr_suspensions(LSusp),
+ ((member((_,div_mod_int(_,B,Q,BQ,_)),LSusp),
+ ((X,Y) == (B,Q); (X,Y) == (Q,B)))
+ ->
+ protected_unify(XY = BQ)
+ ; true)),
+ % On regarde si B divise A dans un div_mod_int
+ get_saved_cstr_suspensions(LSusp),
+ ((member((Susp,div_mod_int(A,B,Q,BQ,R)),LSusp),
+ A == XY,
+ (B == X; %% X=B<>0 divise A donc R = 0
+ B == Y)) %% Y=B<>0 divise A donc R = 0
+ ->
+ % Le div_mod_int devient un mult
+ kill_suspension(Susp),
+ protected_unify(R = 0),
+ protected_unify(BQ = A),
+ call_priority(mult(B,Q,A),4)
+ ; true).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
@@ -6905,44 +6932,70 @@ mult_intervals_diff_both_both(Min1,Max1,Min2,Max2,B1,B2) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- export launch_congr/3.
launch_congr(A,C0,Mod0) :-
- (launch_congr1(A,C0,Mod0) ->
- true
- ; getval(gdbg,1)@eclipse,
- writeln(output,fail_congr),
- fail).
+ (launch_congr1(A,C0,Mod0) ->
+ true
+ ; getval(gdbg,1)@eclipse,
+ writeln(output,fail_congr),
+ fail).
:- mode launch_congr1(?,++,++).
%% Gestion d'une constante
launch_congr1(A,CA,0) :- !,
- protected_unify(A = CA).
+ (get_type(A,real) ->
+ RCA is rational(CA),
+ launch_box_rat(A,RCA)
+ ; protected_unify(A,CA)).
%% Gestion d'une inconnue
launch_congr1(A,_,1) :- !.
launch_congr1(A,_,-1) :- !.
%% Cas normal
launch_congr1(A,C0,Mod0) :-
- %% On normalise C et Mod
- Mod is abs(Mod0),
- C is C0 mod Mod,
- (integer(A) ->
- C is A mod Mod
- ; (exists_congr(A,OldC,OldMod) ->
- inter_congr(C,OldC,Mod,OldMod,NewC,NewMod),
- ((NewC,NewMod) \== (OldC,OldMod) %% On est plus precis
- ->
- set_congr(A,NewC,NewMod),
- reduce_congr_bounds(A,NewC,NewMod),
- %% On a change la congruence de A
- %% Ses contraintes peuvent s'en servir
- my_notify_constrained(A)
- ; %% A priori les bornes de A sont coherentes
- true)
- ; %% Lancement/reduction
- set_congr(A,C,Mod),
- reduce_congr_bounds(A,C,Mod),
- %% On a introduit une congruence pour A
- %% Ses contraintes peuvent s'en servir
- my_notify_constrained(A))).
-
-
+ % On normalise C et Mod
+ Mod is abs(Mod0),
+ C is C0 mod Mod,
+ (number(A) ->
+ (integer(A) ->
+ C is A mod Mod
+ ; C is protected_integer(A) mod Mod)
+ ; (exists_congr(A,OldC,OldMod) ->
+ inter_congr(C,OldC,Mod,OldMod,NewC,NewMod),
+ ((NewC,NewMod) \== (OldC,OldMod) %% On est plus precis
+ ->
+ set_congr(A,NewC,NewMod),
+ reduce_congr_bounds(A,NewC,NewMod),
+ % On a change la congruence de A
+ % Ses contraintes peuvent s'en servir
+ my_notify_constrained(A)
+ ; % A priori les bornes de A sont coherentes
+ true)
+ ; % Lancement/reduction
+ set_congr(A,C,Mod),
+ reduce_congr_bounds(A,C,Mod),
+ % On a introduit une congruence pour A
+ % Ses contraintes peuvent s'en servir
+ my_notify_constrained(A))).
+
+protected_integer(V,I) :-
+ block(I is integer(V),
+ _,
+ (call(spy_here)@eclipse,
+ I is integer(V))).
+
+:- export set_same_congr/2.
+% pour les cast_int_real et cast_real_int
+set_same_congr(A,B) :-
+ (exists_congr(A,CA,MA) ->
+ (exists_congr(B,CB,MB) ->
+ ((CA,MA) == (CB,MB) ->
+ true
+ ; inter_congr(CA,CB,MA,MB,NC,NM),
+ set_congr(A,NC,NM),
+ reduce_congr_bounds(A,NC,NM),
+ set_congr(B,NC,NM),
+ reduce_congr_bounds(B,NC,NM))
+ ; launch_congr(B,CA,MA))
+ ; (exists_congr(B,CB,MB) ->
+ launch_congr(A,CB,MB)
+ ; true)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% COHERENCE DES BORNES
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -6954,27 +7007,112 @@ launch_congr1(A,C0,Mod0) :-
:- mode reduce_congr_bounds(?,++,++).
reduce_congr_bounds(A,C,Mod) :-
- mfd:get_intervals(A,LInter),
- reduce_congr_bounds_interval_list(LInter,C,Mod,NLInter),
- % On n'utilise pas "set_intervals" pour eviter de refaire
- % la reduction de congruence
- (LInter == NLInter ->
- true
- ; NLInter \== [],
- ((NLInter = [Value],
- integer(Value))
+ (get_type(A,int) ->
+ mfd:get_intervals(A,LInter),
+ reduce_congr_bounds_interval_list(LInter,C,Mod,NLInter),
+ NLInter \== [],
+ % On n'utilise pas "set_intervals" pour eviter de refaire
+ % la reduction de congruence
+ (LInter == NLInter ->
+ true
+ ; ((NLInter = [Value],
+ integer(Value))
+ ->
+ protected_unify(A,Value)
+ ; replace_attribute(A,dom(NLInter),mfd),
+ check_constrained_var(A,Constrained),
+ my_notify_constrained(A),
+ wake_if_constrained(Constrained)))
+ ; ((get_type(A,real),
+ is_float_int_number(A))
->
- protected_unify(A = Value)
- ; replace_attribute(A,dom(NLInter),mfd),
- check_constrained_var(A,Constrained),
- my_notify_constrained(A),
- wake_if_constrained(Constrained))).
+ % call(spy_here)@eclipse,
+ ((number(A),Val = A;
+ is_real_box_rat(A,Val))
+ ->
+ C is protected_integer(Val) mod Mod
+ ; mreal:get_intervals(A,LInter),
+ reduce_congr_bounds_interval_list_real(LInter,C,Mod,NLInter,Box),
+ NLInter \== [],
+ (LInter == NLInter ->
+ true
+ ; ((NLInter = [Value],
+ float(Value))
+ ->
+ protected_unify(A,Value)
+ ; (nonvar(Box) ->
+ %call(spy_here)@eclipse,
+ launch_box(A)
+ ; true),
+ real_interval_size(real,NLInter,0,Size),
+ replace_attribute(A,dom(real,NLInter,Size),mreal),
+ check_constrained_var(A,Constrained),
+ my_notify_constrained(A),
+ wake_if_constrained(Constrained))))
+ ; true)).
+
+%% Pour mreal
+:- export
+ reduce_congr_bounds_interval_list_real/5.
+
+reduce_congr_bounds_interval_list_real(LInter,0,1,NLInter,_) :- !.
+reduce_congr_bounds_interval_list_real(LInter,C,M,NLInter,Box) :-
+ reduce_congr_bounds_interval_list_real1(LInter,C,M,NLInter),
+ interval_range(NLInter,Low,High),
+ ((High == 1.0Inf ->
+ get_previous_double_float(High,Low),
+ protected_integer(Low) mod C =\= M
+ ; Low == -1.0Inf,
+ get_next_double_float(Low,High),
+ protected_integer(High) mod C =\= M)
+ ->
+ Box = 1
+ ; true).
+
+reduce_congr_bounds_interval_list_real1([],_,_,[]).
+reduce_congr_bounds_interval_list_real1([Inter|LInter],C,Mod,NLInter) :-
+ block(reduce_congr_bounds_interval_real2(Inter,C,Mod,NLInter,EndNLInter),
+ _,
+ (call(spy_here)@eclipse,
+ reduce_congr_bounds_interval_real2(Inter,C,Mod,NLInter,EndNLInter))),
+ reduce_congr_bounds_interval_list_real1(LInter,C,Mod,EndNLInter).
+
+reduce_congr_bounds_interval_real2(Min..Max,C,Mod,LInter,EndLInter) :- !,
+% (is_inside_mantissa(real,Min) ->
+ (Min \== -1.0Inf ->
+ IMin is protected_integer(Min),
+ reduce_min_congr(IMin,C,Mod,NIMin),
+ float_of_rat(float_double,rtn,NIMin,NMin)
+ % NMin is float(NIMin)
+ ; % Trop grand, on pourait prendre le Min approximé en rtn
+ NMin = Min),
+% (is_inside_mantissa(real,Max) ->
+ (Max \== 1.0Inf ->
+ IMax is protected_integer(Max),
+ reduce_max_congr(IMax,C,Mod,NIMax),
+ float_of_rat(float_double,rtp,NIMax,NMax)
+ % NMax is float(NIMax)
+ ; % Trop grand, on pourait prendre le Max approximé en rtp
+ NMax = Max),
+ (NMin == NMax ->
+ LInter = [NMin|EndLInter]
+ ; (NMin < NMax ->
+ LInter = [NMin..NMax|EndLInter]
+ ; % Pas compatible
+ EndLInter = LInter)).
+reduce_congr_bounds_interval_real2(Val,C,Mod,LInter,EndLInter) :-
+ (C is protected_integer(Val) mod Mod ->
+ LInter = [Val|EndLInter]
+ ; % Pas compatible
+ EndLInter = LInter).
+
%% Pour mfd
:- export
reduce_congr_bounds_interval_list/4.
-%:- mode reduce_congr_bounds_interval_list(++,++,++,?).
+%reduce_congr_bounds_interval_list(LInter,_,_,LInter) :- !.
+
reduce_congr_bounds_interval_list(LInter,0,1,LInter) :- !.
reduce_congr_bounds_interval_list(LInter,C,M,NLInter) :-
reduce_congr_bounds_interval_list1(LInter,C,M,NLInter).
@@ -6987,7 +7125,7 @@ reduce_congr_bounds_interval_list1([Inter|LInter],C,Mod,NLInter) :-
reduce_congr_bounds_interval(Inter,C,Mod,NLInter,EndNLInter))),
reduce_congr_bounds_interval_list1(LInter,C,Mod,EndNLInter).
-:- mode reduce_congr_bounds_interval(++,++,++,?,?).
+%:- mode reduce_congr_bounds_interval(++,++,++,?,?).
reduce_congr_bounds_interval(Min..Max,C,Mod,LInter,EndLInter) :- !,
((%C \== 0,
Min < 0,
@@ -7004,7 +7142,7 @@ reduce_congr_bounds_interval(Min..Max,C,Mod,LInter,EndLInter) :- !,
(NMin == NMax ->
LInter = [NMin|EndLInter]
; (NMin < NMax ->
- ((integer(NMax) - integer(NMin)) div Mod > 1 ->
+ ((protected_integer(NMax) - protected_integer(NMin)) div Mod > 1 ->
% Au moins trois valeurs
LInter = [NMin..NMax|EndLInter]
; % Deux valeurs
@@ -7012,9 +7150,14 @@ reduce_congr_bounds_interval(Min..Max,C,Mod,LInter,EndLInter) :- !,
; % Pas de valeur compatible
EndLInter = LInter))).
reduce_congr_bounds_interval(Val,C,Mod,LInter,EndLInter) :-
- (C is integer(Val) mod Mod ->
- LInter = [Val|EndLInter]
- ; EndLInter = LInter).
+ (Mod == 0 ->
+ % possible pour une constante
+ (protected_integer(Val) =:= C ->
+ LInter = [Val|EndLInter]
+ ; EndLInter = LInter)
+ ; (C is protected_integer(Val) mod Mod ->
+ LInter = [Val|EndLInter]
+ ; EndLInter = LInter)).
%% On cherche le plus petit NMin tel que
@@ -7022,7 +7165,7 @@ reduce_congr_bounds_interval(Val,C,Mod,LInter,EndLInter) :-
:- mode reduce_min_congr(++,++,++,-).
reduce_min_congr(Min,C,Mod,NMin) :-
- IMin is integer(Min),
+ IMin is protected_integer(Min),
CMin is IMin mod Mod,
compare(Order,CMin,C),
reduce_min_congr(Order,CMin,IMin,C,Mod,NMin0),
@@ -7045,7 +7188,7 @@ reduce_min_congr(>,CMin,Min,C,Mod,NMin) :-
%% NMax =< Max et NMax mod Mod = C
:- mode reduce_max_congr(++,++,++,-).
reduce_max_congr(Max,C,Mod,NMax) :-
- IMax is integer(Max),
+ IMax is protected_integer(Max),
CMax is IMax mod Mod,
compare(Order,CMax,C),
reduce_max_congr(Order,CMax,IMax,C,Mod,NMax0),
@@ -7071,43 +7214,47 @@ reduce_max_congr(<,CMax,Max,C,Mod,NMax) :-
%% ADDITION
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-congr_add_directe(A,B,C) :-
- nonvar(A),
- nonvar(B),!,
- C0 is A + B,
- protected_unify(C,C0).
-congr_add_directe(A,B,C) :-
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- congr_add(CA,MA,CB,MB,CC,MC),
- launch_congr(C,CC,MC).
-
-congr_add_inverse(C,B,A) :-
- nonvar(C),
- nonvar(B),!,
- A0 is C - B,
- protected_unify(A,A0).
-congr_add_inverse(C,B,A) :-
- get_congr(C,CC,MC),
- get_congr(B,CB,MB),
- inv_congr_add(CC,MC,CB,MB,CA,MA),
- launch_congr(A,CA,MA).
+congr_add_directe(Type,A,B,C) :-
+ nonvar(A),
+ nonvar(B),!,
+ (Type == int ->
+ C0 is A + B,
+ protected_unify(C,C0)
+ ; true).
+congr_add_directe(Type,A,B,C) :-
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ congr_add(CA,MA,CB,MB,CC,MC),
+ launch_congr(C,CC,MC).
+
+congr_add_inverse(Type,C,B,A) :-
+ nonvar(C),
+ nonvar(B),!,
+ (Type == int ->
+ A0 is C - B,
+ protected_unify(A,A0)
+ ; true).
+congr_add_inverse(Type,C,B,A) :-
+ get_congr(C,CC,MC),
+ get_congr(B,CB,MB),
+ inv_congr_add(CC,MC,CB,MB,CA,MA),
+ launch_congr(A,CA,MA).
%% A + B --> C
:- mode congr_add(++,++,++,++,-,-).
congr_add(CA,ModA,CB,ModB,CC,ModC) :-
- ModC is gcd(ModA,ModB),
- (ModC == 1 ->
- CC = 0
- ; CC is CA+CB).
+ ModC is gcd(ModA,ModB),
+ (ModC == 1 ->
+ CC = 0
+ ; CC is CA+CB).
%% C - B --> A
:- mode inv_congr_add(++,++,++,++,-,-).
inv_congr_add(CC,ModC,CB,ModB,CA,ModA) :-
- ModA is gcd(ModC,ModB),
- (ModA == 1 ->
- CA = 0
- ; CA is CC - CB).
+ ModA is gcd(ModC,ModB),
+ (ModA == 1 ->
+ CA = 0
+ ; CA is CC - CB).
@@ -7117,127 +7264,163 @@ inv_congr_add(CC,ModC,CB,ModB,CA,ModA) :-
%%fp_congr_mult(A,B,C) :- !.
-fp_congr_mult(A,A,B) ?- !,
- fp_congr_power(A,2,B).
-
-fp_congr_mult(A,B,A) ?- !,
- %% si A=1[2] alors B = 1[2] donc A et B <> 0 et B = 1
- %% si B=0[2] alors A*B=A=0[2] donc on itere et A*B=A=0[4] ...
- %% On observe alors une convergence
- %% lente dans les congruences doublant la congruence de A
- %% jusqu'a exclure toutes les valeurs sauf 0 pour A
- ((((is_odd(A);
- not_unify(A,0)),
- Var = B,
- Val = 1);
- ((is_even(B);
- not_unify(B,1)),
- Var = A,
- Val = 0))
- ->
- protected_unify(Var = Val)
- ; fp_congr_mult_bis(A,B,A)).
-fp_congr_mult(B,A,A) ?- !,
- fp_congr_mult(A,B,A).
-fp_congr_mult(A,B,C) :-
- fp_congr_mult_bis(A,B,C).
-fp_congr_mult_bis(A,B,C) :-
- (check_is_prime(C) ->
- OpC is -C,
- (C > 0 ->
- Inter = [OpC,-1,1,C]
- ; Inter = [C,-1,1,OpC]),
- mfd:quiet_set_intervals(A,Inter),
- mfd:quiet_set_intervals(B,Inter)
- ; true),
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- fp_congr_mult(A,B,C,CA,MA,CB,MB).
-
-is_odd(A) :-
- number(A),!,
- mod(A,2,1).
-is_odd(A) :-
- not launch_congr(A,0,2).
-is_even(A) :-
- number(A),!,
- mod(A,2,0).
-is_even(A) :-
- not launch_congr(A,1,2).
-
-
-fp_congr_mult(A,B,C,CA,MA,CB,MB) :-
- congr_mult_directe(A,B,C),
- get_congr(C,CC,MC),
- (inter_congr(0,CC,2,MC,_,_) ->
- %% C peut etre pair
- true
- ; %% C ne peut pas etre pair donc A,B et C sont impairs
- launch_congr(B,1,2),
- launch_congr(A,1,2)),
- congr_mult_inverse(C,B,A),
- congr_mult_inverse(C,A,B),
- get_congr(A,NCA,NMA),
- get_congr(B,NCB,NMB),
- ((NCA,NMA,NCB,NMB) == (CA,MA,CB,MB) ->
- true
- ; fp_congr_mult(A,B,C,NCA,NMA,NCB,NMB)).
-
-congr_mult_directe(A,B,C) :-
- nonvar(A),
- nonvar(B),!,
- C0 is A * B,
- protected_unify(C,C0).
-congr_mult_directe(A,B,C) :-
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- congr_mult(CA,MA,CB,MB,CC,MC),
- launch_congr(C,CC,MC).
+fp_congr_mult(Type,A,A,B) ?- !,
+ fp_congr_power(Type,A,2,B).
+
+fp_congr_mult(Type,A,B,A) ?- !,
+ % si A=1[2] alors B = 1[2] donc A et B <> 0 et B = 1
+ % si B=0[2] alors A*B=A=0[2] donc on itere et A*B=A=0[4] ...
+ % On observe alors une convergence
+ % lente dans les congruences doublant la congruence de A
+ % jusqu'a exclure toutes les valeurs sauf 0 pour A
+ (Type == int ->
+ Zero = 0,
+ One = 1
+ ; Zero = 0.0,
+ One = 1.0),
+ ((((is_odd(Type,A);
+ not_unify(A,Zero)),
+ Var = B,
+ Val = One);
+ ((is_even(Type,B);
+ not_unify(B,One)),
+ Var = A,
+ Val = Zero))
+ ->
+ protected_unify(Var,Val)
+ ; fp_congr_mult_bis(Type,A,B,A)).
+
+fp_congr_mult(Type,B,A,A) ?- !,
+ fp_congr_mult(Type,A,B,A).
+fp_congr_mult(Type,A,B,C) :-
+ fp_congr_mult_bis(Type,A,B,C).
+fp_congr_mult_bis(Type,A,B,C) :-
+ (check_is_prime(Type,C) ->
+ OpC is -C,
+ (Type == int ->
+ (C > 0 ->
+ Inter = [OpC,-1,1,C]
+ ; Inter = [C,-1,1,OpC]),
+ mfd:quiet_set_intervals(A,Inter),
+ mfd:quiet_set_intervals(B,Inter)
+ ; (C > 0.0 ->
+ Inter = [OpC,-1.0,1.0,C]
+ ; Inter = [C,-1.0,1.0,OpC]),
+ mreal:set_typed_intervals(A,real,Inter),
+ mreal:set_typed_intervals(B,real,Inter))
+ ; true),
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ fp_congr_mult(Type,A,B,C,CA,MA,CB,MB).
+
+is_odd(Type,A) :-
+ number(A),!,
+ (Type == int ->
+ NA = A
+ ; protected_integer(A,NA)),
+ mod(NA,2,1).
+is_odd(_,A) :-
+ not launch_congr(A,0,2).
+is_even(Type,A) :-
+ number(A),!,
+ (Type == int ->
+ NA = A
+ ; protected_integer(A,NA)),
+ mod(NA,2,0).
+is_even(_,A) :-
+ not launch_congr(A,1,2).
+
+
+fp_congr_mult(Type,A,B,C,CA,MA,CB,MB) :-
+ congr_mult_directe(Type,A,B,C),
+ get_congr(C,CC,MC),
+ (inter_congr(0,CC,2,MC,_,_) ->
+ % C peut etre pair
+ true
+ ; % C ne peut pas etre pair donc A,B et C sont impairs
+ launch_congr(B,1,2),
+ launch_congr(A,1,2)),
+ congr_mult_inverse(Type,C,B,A),
+ congr_mult_inverse(Type,C,A,B),
+ get_congr(A,NCA,NMA),
+ get_congr(B,NCB,NMB),
+ ((NCA,NMA,NCB,NMB) == (CA,MA,CB,MB) ->
+ true
+ ; fp_congr_mult(Type,A,B,C,NCA,NMA,NCB,NMB)).
+
+congr_mult_directe(Type,A,B,C) :-
+ nonvar(A),
+ nonvar(B),!,
+ (Type == int ->
+ C0 is A * B,
+ protected_unify(C,C0)
+ ; true).
+congr_mult_directe(Type,A,B,C) :-
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ congr_mult(CA,MA,CB,MB,CC,MC),
+ launch_congr(C,CC,MC).
%% C/B --> A
-congr_mult_inverse(C,B,0) ?- !,
- protected_unify(C = 0).
-congr_mult_inverse(C,0,A) ?- !,
- protected_unify(C = 0).
-congr_mult_inverse(0,B,A) ?- !.
-congr_mult_inverse(C,B,A) :-
- nonvar(C),
- nonvar(B),!,
- (B == 0 ->
- protected_unify(C = 0)
- ; A0 is C // B,
+congr_mult_inverse(int,C,B,0) ?- !,
+ protected_unify(C,0).
+congr_mult_inverse(int,C,0,A) ?- !,
+ protected_unify(C,0).
+congr_mult_inverse(int,0,B,A) ?- !.
+congr_mult_inverse(int,C,B,A) :-
+ nonvar(C),
+ nonvar(B),!,
+ (B == 0 ->
+ protected_unify(C,0)
+ ; A0 is C // B,
protected_unify(A,A0),
- 0 is C rem B).
-congr_mult_inverse(C,B,A) :-
- get_congr(C,CC,MC),
- get_congr(B,CB,MB),
- get_congr(A,CA,MA),
- congr_mult_inverse(C,B,CC,MC,CB,MB,CA,MA,A).
-
-congr_mult_inverse(C,B,CC,MC,CB,MB,CA,MA,A) :-
- %% C/B --> A
- %% Si DA "divise" la congruence A et la congruence de C
- %% on (C/DA)/B --> (A/DA)
- ((GCDA is gcd(CA,MA),
- GCDA \== 1,
- GCDC is gcd(CC,MC),
- GCDC \== 1,
- DA is gcd(GCDA,GCDC),
- DA \== 1)
- ->
- NCC is CC div DA,
- NMC is MC div DA,
- %% On regarde la congruence de A/DA a partir
- %% de (C/DA) / B
- inv_congr_mult(NCC,NMC,CB,MB,CAdDA,MAdDA),
- NCA is DA*CAdDA,
- NMA is DA*MAdDA
- ; inv_congr_mult(CC,MC,CB,MB,NCA,NMA)),
- launch_congr(A,NCA,NMA),
- get_congr(A,NewCA,NewMA),
- ((CA,MA) == (NewCA,NewMA) ->
- true
- ; congr_mult_inverse(C,B,CC,MC,CB,MB,NewCA,NewMA,A)).
+ 0 is C rem B).
+congr_mult_inverse(real,C,B,0.0) ?- !,
+ protected_unify(C,0.0).
+congr_mult_inverse(real,C,0.0,A) ?- !,
+ protected_unify(C,0.0).
+congr_mult_inverse(real,0.0,B,A) ?- !.
+congr_mult_inverse(real,C,B,A) :-
+ nonvar(C),
+ nonvar(B),!,
+ (B == 0.0 ->
+ protected_unify(C,0.0)
+ ; protected_integer(C,IC),
+ protected_integer(B,IB),
+ % A priori c'est représentable
+ A0 is float(IC // IB),
+ protected_unify(A,A0),
+ 0 is IC rem IB).
+congr_mult_inverse(_,C,B,A) :-
+ get_congr(C,CC,MC),
+ get_congr(B,CB,MB),
+ get_congr(A,CA,MA),
+ congr_mult_inverse(CC,MC,CB,MB,CA,MA,A).
+
+congr_mult_inverse(CC,MC,CB,MB,CA,MA,A) :-
+ % C/B --> A
+ % Si DA "divise" la congruence A et la congruence de C
+ % on (C/DA)/B --> (A/DA)
+ ((GCDA is gcd(CA,MA),
+ GCDA \== 1,
+ GCDC is gcd(CC,MC),
+ GCDC \== 1,
+ DA is gcd(GCDA,GCDC),
+ DA \== 1)
+ ->
+ NCC is CC div DA,
+ NMC is MC div DA,
+ % On regarde la congruence de A/DA a partir
+ % de (C/DA) / B
+ inv_congr_mult(NCC,NMC,CB,MB,CAdDA,MAdDA),
+ NCA is DA*CAdDA,
+ NMA is DA*MAdDA
+ ; inv_congr_mult(CC,MC,CB,MB,NCA,NMA)),
+ launch_congr(A,NCA,NMA),
+ get_congr(A,NewCA,NewMA),
+ ((CA,MA) == (NewCA,NewMA) ->
+ true
+ ; congr_mult_inverse(CC,MC,CB,MB,NewCA,NewMA,A)).
%% A * B --> C
@@ -7247,16 +7430,16 @@ congr_mult_inverse(C,B,CC,MC,CB,MB,CA,MA,A) :-
congr_mult(_,1,_,1,0,1) :- !.
%% A constante
congr_mult(CA,0,CB,ModB,CC,ModC) :- !,
- CC is CA * CB,
- ModC is CA * ModB.
+ CC is CA * CB,
+ ModC is CA * ModB.
%% B constante
congr_mult(CA,ModA,CB,0,CC,ModC) :- !,
- CC is CA * CB,
- ModC is CB * ModA.
+ CC is CA * CB,
+ ModC is CB * ModA.
%% Cas normal
congr_mult(CA,ModA,CB,ModB,CC,ModC) :-
- CC is CA * CB,
- ModC is gcd(gcd(ModA*ModB,ModA*CB),ModB*CA).
+ CC is CA * CB,
+ ModC is gcd(gcd(ModA*ModB,ModA*CB),ModB*CA).
:- import
@@ -7299,294 +7482,333 @@ inv_congr_mult(CC,ModC,CB,ModB,CA,ModA) :-
%% OPPOSE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-congr_op_directe(A,B) :-
- var(A),!,
- get_congr(A,CA,MA),
- congr_op_directe(CA,MA,B).
-congr_op_directe(A,B) :-
- B0 is - A,
- protected_unify(B,B0).
+congr_op_directe(_,A,B) :-
+ var(A),!,
+ get_congr(A,CA,MA),
+ congr_op_directe1(CA,MA,B).
+congr_op_directe(Type,A,B) :-
+ (Type == int ->
+ B0 is - A,
+ protected_unify(B,B0)
+ ; true).
-:- mode congr_op_directe(++,++,?).
-congr_op_directe(_,1,_) :- !. %% A inconnue
-congr_op_directe(CA,MA,B) :-
- CB is - CA,
- launch_congr(B,CB,MA).
+%:- mode congr_op_directe1(++,++,?).
+congr_op_directe1(_,1,_) :- !. %% A inconnue
+congr_op_directe1(CA,MA,B) :-
+ CB is - CA,
+ launch_congr(B,CB,MA).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% VALEUR ABSOLUE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
congr_abs_directe(Val,Abs,Stop) :-
- nonvar(Val),!,
- Stop = 1,
- Abs0 is abs(Val),
- protected_unify(Abs,Abs0).
+ nonvar(Val),!,
+ Stop = 1,
+ % OK pour int et real
+ (Val =:= 0 ->
+ protected_unify(Abs,Val)
+ ; Abs0 is abs(Val),
+ protected_unify(Abs,Abs0)).
congr_abs_directe(Val,Abs,Stop) :-
- get_congr(Val,CVal,ModVal),
- %% Propagation vers Abs
- (ModVal == 1 ->
- %% Pas de propagation sur Abs
- true
- ; %% Si les congruences de Val et op(Val)
- %% sont identiques on propage
- OpCVal is (- CVal) mod ModVal,
- (OpCVal == CVal ->
- launch_congr(Abs,CVal,ModVal)
- ; %% Si une des congruences opposees
- %% est inconsistante, alors c'est l'autre
- get_congr(Abs,CAbs,ModAbs),
- (inter_congr(CAbs,CVal,ModAbs,ModVal,C1,Mod1) ->
- (inter_congr(CAbs,OpCVal,ModAbs,ModVal,C2,Mod2) ->
- %% (C1,Mod1) <> (C2,Mod2)
- %% Pas de propagation
- true
- ; Stop = 1,
- launch_congr(Abs,C1,Mod1),
- protected_unify(Val = Abs))
- ; %% Abs = op(Val)
- Stop = 1,
- op_int_bis(Val,Abs)))).
+ get_congr(Val,CVal,ModVal),
+ % Propagation vers Abs
+ (ModVal == 1 ->
+ % Pas de propagation sur Abs
+ true
+ ; % Si les congruences de Val et op(Val)
+ % sont identiques on propage
+ OpCVal is (- CVal) mod ModVal,
+ (OpCVal == CVal ->
+ launch_congr(Abs,CVal,ModVal)
+ ; % Si une des congruences opposees
+ % est inconsistante, alors c'est l'autre
+ get_congr(Abs,CAbs,ModAbs),
+ (inter_congr(CAbs,CVal,ModAbs,ModVal,C1,Mod1) ->
+ (inter_congr(CAbs,OpCVal,ModAbs,ModVal,C2,Mod2) ->
+ % (C1,Mod1) <> (C2,Mod2)
+ % Pas de propagation
+ true
+ ; Stop = 1,
+ launch_congr(Abs,C1,Mod1),
+ protected_unify(Val,Abs))
+ ; % Abs = op(Val)
+ Stop = 1,
+ (get_type(Val,int) ->
+ op_int_bis(Val,Abs)
+ ; op_real(real,Val,Abs))))).
congr_abs_inverse(Val,Abs,Stop) :-
- nonvar(Abs),!,
- Stop = 1,
- OpAbs is - Abs,
- mfd:quiet_set_intervals(Val,[OpAbs,Abs]).
+ nonvar(Abs),!,
+ Stop = 1,
+ (Abs =:= 0 ->
+ protected_unify(Abs,Val)
+ ; OpAbs is - Abs,
+ (get_type(Abs,int) ->
+ mfd:quiet_set_intervals(Val,[OpAbs,Abs])
+ ; mreal:set_typed_intervals(Val,real,[OpAbs,Abs]))).
congr_abs_inverse(Val,Abs,Stop) :-
- get_congr(Abs,NCAbs,NModAbs),
- (NModAbs == 1 ->
- %% Pas de propagation sur Val
- true
- ; OpCAbs is (- NCAbs) mod NModAbs,
- (OpCAbs == NCAbs ->
- launch_congr(Val,NCAbs,NModAbs)
- ; %% Si une des congruences opposees
- %% est inconsistante, alors c'est l'autre
- get_congr(Val,CVal,ModVal),
- (inter_congr(NCAbs,CVal,NModAbs,ModVal,C3,Mod3) ->
- (inter_congr(OpCAbs,CVal,NModAbs,ModVal,C4,Mod4) ->
- %% (C3,Mod3) <> (C4,Mod4)
- %% Pas de propagation
- true
- ; Stop = 1,
- launch_congr(Val,C3,Mod3),
- protected_unify(Val = Abs))
- ; %% Abs = op(Val)
- Stop = 1,
- op_int_bis(Val,Abs)))).
+ get_congr(Abs,NCAbs,NModAbs),
+ (NModAbs == 1 ->
+ % Pas de propagation sur Val
+ true
+ ; OpCAbs is (- NCAbs) mod NModAbs,
+ (OpCAbs == NCAbs ->
+ launch_congr(Val,NCAbs,NModAbs)
+ ; % Si une des congruences opposees
+ % est inconsistante, alors c'est l'autre
+ get_congr(Val,CVal,ModVal),
+ (inter_congr(NCAbs,CVal,NModAbs,ModVal,C3,Mod3) ->
+ (inter_congr(OpCAbs,CVal,NModAbs,ModVal,C4,Mod4) ->
+ % (C3,Mod3) <> (C4,Mod4)
+ % Pas de propagation
+ true
+ ; Stop = 1,
+ launch_congr(Val,C3,Mod3),
+ protected_unify(Val,Abs))
+ ; % Abs = op(Val)
+ Stop = 1,
+ (get_type(Abs,int) ->
+ op_int_bis(Val,Abs)
+ ; op_real(real,Val,Abs))))).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% PUISSANCE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-fp_congr_power(A,N,B) :-
- fp_congr_power(A,N,B,1,1).
-
-fp_congr_power(A,N,B,TA,TB) :-
- (TA == 1 ->
- get_congr(B,CB,MB),
- congr_power_directe(A,N,B),
- get_congr(B,NCB,NMB),
- ((CB,MB) == (NCB,NMB) ->
- true
- ; TB = 1)
- ; true),
- (TB == 1 ->
- get_congr(A,CA,MA),
- congr_power_inverse(B,N,A),
- get_congr(A,NCA,NMA),
- ((CA,MA) == (NCA,NMA) ->
- true
- ; fp_congr_power(A,N,B,1,_))
- ; true).
+fp_congr_power(Type,A,N,B) :-
+ fp_congr_power(Type,A,N,B,1,1).
+
+fp_congr_power(Type,A,N,B,TA,TB) :-
+ (TA == 1 ->
+ get_congr(B,CB,MB),
+ congr_power_directe(Type,A,N,B),
+ get_congr(B,NCB,NMB),
+ ((CB,MB) == (NCB,NMB) ->
+ true
+ ; TB = 1)
+ ; true),
+ (TB == 1 ->
+ get_congr(A,CA,MA),
+ congr_power_inverse(Type,B,N,A),
+ get_congr(A,NCA,NMA),
+ ((CA,MA) == (NCA,NMA) ->
+ true
+ ; fp_congr_power(Type,A,N,B,1,_))
+ ; true).
-congr_power_directe(A,N,B) :-
- nonvar(A),!,
- B0 is pow_int(A,N),
- protected_unify(B,B0).
-congr_power_directe(A,N,B) :-
- (exists_congr(A,CA,MA) ->
- congr_power_directe(CA,MA,N,CB,MB),
- launch_congr(B,CB,MB)
- ; true).
+congr_power_directe(Type,A,N,B) :-
+ nonvar(A),!,
+ (Type == int ->
+ B0 is pow_int(A,N),
+ protected_unify(B,B0)
+ ; true).
+congr_power_directe(Type,A,N,B) :-
+ (exists_congr(A,CA,MA) ->
+ congr_power_directe(CA,MA,N,CB,MB),
+ launch_congr(B,CB,MB)
+ ; true).
congr_power_directe(CA,MA,N,CB,MB) :-
- N >= 2,!,
- %% A^(2n+1) = A * A^n*A^n = A * (A^n)^2
- Nd2 is N div 2,
- congr_power_directe(CA,MA,Nd2,C,Mod),
- (Mod == 1 ->
- CB = 0,
- MB = 1
- ; C2 is C*C,
- M2 is Mod * gcd(2*C + Mod, 2*Mod),
- (N mod 2 =:= 0 ->
- CB = C2,
- MB = M2
- ; congr_mult(CA,MA,C2,M2,CB,MB))).
+ N >= 2,!,
+ % A^(2n+1) = A * A^n*A^n = A * (A^n)^2
+ Nd2 is N div 2,
+ congr_power_directe(CA,MA,Nd2,C,Mod),
+ (Mod == 1 ->
+ CB = 0,
+ MB = 1
+ ; C2 is C*C,
+ M2 is Mod * gcd(2*C + Mod, 2*Mod),
+ (N mod 2 =:= 0 ->
+ CB = C2,
+ MB = M2
+ ; congr_mult(CA,MA,C2,M2,CB,MB))).
congr_power_directe(CA,MA,_,CA,MA).
-congr_power_inverse(B,N,A) :-
- nonvar(B),!,
- abs(B,AbsB),
- int_nroot(AbsB,N,Root),
- (B >= 0 ->
- (N mod 2 =:= 0 ->
- %% A neg ou pos
- OpRoot is -Root,
- mfd:(A::[OpRoot, Root])
- ; %% A et B du meme signe
- A0 = Root,
+congr_power_inverse(int,B,N,A) ?-
+ nonvar(B),!,
+ abs(B,AbsB),
+ int_nroot(AbsB,N,Root),
+ (B >= 0 ->
+ (N mod 2 =:= 0 ->
+ % A neg ou pos
+ OpRoot is -Root,
+ mfd:(A::[OpRoot, Root])
+ ; % A et B du meme signe
+ A0 = Root,
+ protected_unify(A,A0))
+ ; % A et B du meme signe
+ A0 is -Root,
+ protected_unify(A,A0)).
+congr_power_inverse(real,B,N,A) ?-
+ nonvar(B),!,
+ IAbsB is abs(protected_integer(B)),
+ int_nroot(IAbsB,N,IRoot),
+ (B >= 0 ->
+ (N mod 2 =:= 0 ->
+ % A neg ou pos
+ Root is float(IRoot),
+ OpRoot is -Root,
+ mreal:(A::[OpRoot, Root])
+ ; % A et B du meme signe
+ A0 is float(IRoot),
protected_unify(A,A0))
- ; %% A et B du meme signe
- A0 is -Root,
+ ; % A et B du meme signe
+ A0 is -(float(IRoot)),
protected_unify(A,A0)).
-congr_power_inverse(B,N,A) :-
- exists_congr(B,CB,MB),!,
- congr_power_inverse(CB,MB,B,N,A).
-
-congr_power_inverse(B,N,A).
-
-congr_power_inverse(CB,MB,B,N,A) :-
- GCD is gcd(CB,MB),
- (GCD > 1 ->
- %% On regarde les premiers nombres premiers
- (is_mult_prime_powN(GCD,N,PrimePk,PrimePkPN) ->
- %% On a trouv� (Prime^k)^N qui divise GCD (donc B)
- %% donc Prime^k doit diviser A
- DivA = PrimePk,
- DivB = PrimePkPN,
- CallRec = 1
- ; findall(Prime,is_mult_prime(GCD,Prime),Primes),
- mult_int_list(Primes,1,ProdPrimes),
- %% ProdPrimes est un produit de (petits) nombres premiers qui divise GCD,
- %% donc il divise aussi A
- DivA = ProdPrimes),
-
- launch_congr(A,0,DivA),
- congr_power_directe(A,N,B),
- (nonvar(CallRec) ->
- %% PrimePk^N divise GCD
- NCB is CB div DivB,
- NMB is MB div DivB,
- mfd:dvar_range(A,LA,HA),
- mfd:dvar_range(B,LB,HB),
- mfd:quiet_set_intervals(NA,[LA..HA]),
- mfd:quiet_set_intervals(NB,[LB..HB]),
- launch_congr(NB,NCB,NMB),
- congr_power_inverse(NCB,NMB,NB,N,NA),
- ((get_congr(NA,CNA,MNA),
- MNA > 1)
- ->
- %% A = NA*DivA
- congr_mult(DivA,0,CNA,MNA,CA,MA),
- launch_congr(A,CA,MA),
- congr_power_directe(A,N,B),
- %% B = NB*DivB
- get_congr(NB,NCB1,NMB1),
- congr_mult(DivB,0,NCB1,NMB1,CB1,MB1),
- launch_congr(B,CB1,MB1)
- ; true)
- ; true)
- ; %% A et A^N=B ont la meme parite
- ((not inter_congr(0,CB,2,MB,_,_)) ->
- launch_congr(A,1,2),
- congr_power_directe(A,N,B)
- ; ((not inter_congr(1,CB,2,MB,_,_)) ->
- launch_congr(A,0,2),
- congr_power_directe(A,N,B)
- ; true))),
- (exists_congr(A,NewCA,NewMA) ->
- %% On a peut etre bouge B
- get_congr(B,NewCB,NewMB),
- fp_congr_power_inverse(B,N,A,NewCB,NewMB,NewCA,NewMA)
- ; true).
+congr_power_inverse(Type,B,N,A) :-
+ exists_congr(B,CB,MB),!,
+ congr_power_inverse(Type,CB,MB,B,N,A).
+
+congr_power_inverse(_,B,N,A).
+
+congr_power_inverse(Type,CB,MB,B,N,A) :-
+ GCD is gcd(CB,MB),
+ (GCD > 1 ->
+ % On regarde les premiers nombres premiers
+ (is_mult_prime_powN(GCD,N,PrimePk,PrimePkPN) ->
+ % On a trouv� (Prime^k)^N qui divise GCD (donc B)
+ % donc Prime^k doit diviser A
+ DivA = PrimePk,
+ DivB = PrimePkPN,
+ CallRec = 1
+ ; findall(Prime,is_mult_prime(GCD,Prime),Primes),
+ mult_int_list(Primes,1,ProdPrimes),
+ % ProdPrimes est un produit de (petits) nombres premiers qui divise GCD,
+ % donc il divise aussi A
+ DivA = ProdPrimes),
+
+ launch_congr(A,0,DivA),
+ congr_power_directe(Type,A,N,B),
+ (nonvar(CallRec) ->
+ % PrimePk^N divise GCD
+ NCB is CB div DivB,
+ NMB is MB div DivB,
+ (Type == int ->
+ mfd:dvar_range(A,LA,HA),
+ mfd:dvar_range(B,LB,HB),
+ mfd:quiet_set_intervals(NA,[LA..HA]),
+ mfd:quiet_set_intervals(NB,[LB..HB])
+ ; mreal:dvar_range(A,LA,HA),
+ mreal:dvar_range(B,LB,HB),
+ set_typed_intervals(NA,real,[LA..HA]),
+ set_typed_intervals(NB,real,[LB..HB])),
+ launch_congr(NB,NCB,NMB),
+ congr_power_inverse(int,NCB,NMB,NB,N,NA),
+ ((get_congr(NA,CNA,MNA),
+ MNA > 1)
+ ->
+ % A = NA*DivA
+ congr_mult(DivA,0,CNA,MNA,CA,MA),
+ launch_congr(A,CA,MA),
+ congr_power_directe(Type,A,N,B),
+ % B = NB*DivB
+ get_congr(NB,NCB1,NMB1),
+ congr_mult(DivB,0,NCB1,NMB1,CB1,MB1),
+ launch_congr(B,CB1,MB1)
+ ; true)
+ ; true)
+ ; % A et A^N=B ont la meme parite
+ ((not inter_congr(0,CB,2,MB,_,_)) ->
+ launch_congr(A,1,2),
+ congr_power_directe(Type,A,N,B)
+ ; ((not inter_congr(1,CB,2,MB,_,_)) ->
+ launch_congr(A,0,2),
+ congr_power_directe(Type,A,N,B)
+ ; true))),
+ (exists_congr(A,NewCA,NewMA) ->
+ % On a peut etre bouge B
+ get_congr(B,NewCB,NewMB),
+ fp_congr_power_inverse(B,N,A,NewCB,NewMB,NewCA,NewMA)
+ ; true).
mult_int_list([],Prod,Prod).
mult_int_list([P|LP],Prod,Res) :-
- NProd is P*Prod,
- mult_int_list(LP,NProd,Res).
+ NProd is P*Prod,
+ mult_int_list(LP,NProd,Res).
fp_congr_power_inverse(B,N,A,CB,MB,CA,MA) :-
- (N == 2 ->
- inv_congr_mult(CB,MB,CA,MA,CA1,MA1)
- ; %% B = A * A^(N-1)
- NN is N - 1,
- congr_power_directe(CA,MA,NN,CANN,MANN),
- inv_congr_mult(CB,MB,CANN,MANN,CA1,MA1)),
- inter_congr(CA,CA1,MA,MA1,NCA,NMA),
- ((CA,MA) == (NCA,NMA) ->
- launch_congr(A,CA,MA),
- launch_congr(B,CB,MB)
- ; congr_power_directe(NCA,NMA,N,CB1,MB1),
- inter_congr(CB,CB1,MB,MB1,NCB,NMB),
- fp_congr_power_inverse(B,N,A,NCB,NMB,NCA,NMA)).
+ (N == 2 ->
+ inv_congr_mult(CB,MB,CA,MA,CA1,MA1)
+ ; % B = A * A^(N-1)
+ NN is N - 1,
+ congr_power_directe(CA,MA,NN,CANN,MANN),
+ inv_congr_mult(CB,MB,CANN,MANN,CA1,MA1)),
+ inter_congr(CA,CA1,MA,MA1,NCA,NMA),
+ ((CA,MA) == (NCA,NMA) ->
+ launch_congr(A,CA,MA),
+ launch_congr(B,CB,MB)
+ ; congr_power_directe(NCA,NMA,N,CB1,MB1),
+ inter_congr(CB,CB1,MB,MB1,NCB,NMB),
+ fp_congr_power_inverse(B,N,A,NCB,NMB,NCA,NMA)).
%% On teste seulement les premiers nombres premiers
first_primes([2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101]).
-check_is_prime(V) :-
- nonvar(V),
- V \== 0,
- abs(V,AV),
- is_prime(AV).
+check_is_prime(Type,V) :-
+ nonvar(V),
+ (Type == int ->
+ NV = V
+ ; protected_integer(V,NV)),
+ NV \== 0,
+ abs(NV,AV),
+ is_prime(AV).
is_prime(Prime) :-
- first_primes(Primes),
- member(Prime,Primes).
+ first_primes(Primes),
+ member(Prime,Primes).
is_mult_prime(V,Prime) :-
- V \== 0,
- abs(V,AV),
- (is_prime(AV) ->
- Prime = AV
- ; %% On peut limiter le parcours sous AV // 2
- AVd2 is AV // 2,
- is_prime(Prime),
- (Prime =< AVd2 ->
- mod(AV,Prime,0)
- ; !,
- fail)).
+ V \== 0,
+ abs(V,AV),
+ (is_prime(AV) ->
+ Prime = AV
+ ; % On peut limiter le parcours sous AV // 2
+ AVd2 is AV // 2,
+ is_prime(Prime),
+ (Prime =< AVd2 ->
+ mod(AV,Prime,0)
+ ; !,
+ fail)).
is_mult_prime_powN(GCD,N,PrimePkN,PrimePkNPN) :-
- %% Exemple: N=3, Val = 81 = 3^3 * 3
- member(Prime,[2,3,5,7,11]),
- mod(GCD,Prime,0),
- PrimePowN is pow_int(Prime,N),
- (PrimePowN =< GCD ->
- mod(GCD,PrimePowN,0)
- ; %% Inutile de continuer
- !,
- fail),
- !,
- (PrimePowN == GCD ->
- PrimePkN = Prime,
- PrimePkNPN = GCD
- ; %% On a peut etre une plus grande puissance divisible par N
- max_powPrime_dividing(GCD,Prime,MaxPowPrime),
- PkN is MaxPowPrime div N,
- PrimePkN is pow_int(Prime,PkN),
- PrimePkNPN is pow_int(PrimePkN,N)).
+ % Exemple: N=3, Val = 81 = 3^3 * 3
+ member(Prime,[2,3,5,7,11]),
+ mod(GCD,Prime,0),
+ PrimePowN is pow_int(Prime,N),
+ (PrimePowN =< GCD ->
+ mod(GCD,PrimePowN,0)
+ ; % Inutile de continuer
+ !,
+ fail),
+ !,
+ (PrimePowN == GCD ->
+ PrimePkN = Prime,
+ PrimePkNPN = GCD
+ ; % On a peut etre une plus grande puissance divisible par N
+ max_powPrime_dividing(GCD,Prime,MaxPowPrime),
+ PkN is MaxPowPrime div N,
+ PrimePkN is pow_int(Prime,PkN),
+ PrimePkNPN is pow_int(PrimePkN,N)).
max_powPrime_dividing(GCD,Prime,MaxPowPrime) :-
- max_logPrime(Prime,MaxLogPrime),
- PrimePowMax is pow_int(Prime,MaxLogPrime),
- NGCD is gcd(PrimePowMax,GCD),
- (NGCD < PrimePowMax ->
- MaxPowPrime is integer(floor_logN(Prime,NGCD))
- ; NewGCD is GCD div NGCD,
- max_powPrime_dividing(NewGCD,Prime,MaxLogPrime,PrimePowMax,MaxLogPrime,MaxPowPrime)).
+ max_logPrime(Prime,MaxLogPrime),
+ PrimePowMax is pow_int(Prime,MaxLogPrime),
+ NGCD is gcd(PrimePowMax,GCD),
+ (NGCD < PrimePowMax ->
+ MaxPowPrime is protected_integer(floor_logN(Prime,NGCD))
+ ; NewGCD is GCD div NGCD,
+ max_powPrime_dividing(NewGCD,Prime,MaxLogPrime,PrimePowMax,MaxLogPrime,MaxPowPrime)).
max_powPrime_dividing(GCD,Prime,MaxLogPrime,PrimePowMax,AccuPPrime,MaxPowPrime) :-
- NGCD is gcd(PrimePowMax,GCD),
- (NGCD < PrimePowMax ->
- MaxPowPrime is AccuPPrime + integer(floor_logN(Prime,NGCD))
- ; NewGCD is GCD div NGCD,
- NAccuPPrime is AccuPPrime + MaxLogPrime,
- max_powPrime_dividing(NewGCD,Prime,MaxLogPrime,PrimePowMax,NAccuPPrime,MaxPowPrime)).
+ NGCD is gcd(PrimePowMax,GCD),
+ (NGCD < PrimePowMax ->
+ MaxPowPrime is AccuPPrime + protected_integer(floor_logN(Prime,NGCD))
+ ; NewGCD is GCD div NGCD,
+ NAccuPPrime is AccuPPrime + MaxLogPrime,
+ max_powPrime_dividing(NewGCD,Prime,MaxLogPrime,PrimePowMax,NAccuPPrime,MaxPowPrime)).
max_logPrime(2,1023) :- !.
@@ -7595,86 +7817,85 @@ max_logPrime(5,441) :- !.
max_logPrime(7,364) :- !.
max_logPrime(11,296) :- !.
max_logPrime(P,MaxLogP) :-
- MaxDouble is get_previous_double_float(1.0Inf),
- MaxLogP is integer(floor_logN(P,MaxDouble)).
+ MaxDouble is get_previous_double_float(1.0Inf),
+ MaxLogP is protected_integer(floor_logN(P,MaxDouble)).
max_pow2_dividing(Val,MaxP2) :-
- Deux1023 is 2^1023,
- GCD is gcd(Deux1023,Val),
- (GCD < Deux1023 ->
- MaxP2 is integer(floor_log2(GCD))
- ; NVal is Val div Deux1023,
- max_pow2_dividing(NVal,Deux1023,Deux1023,MaxP2)).
+ Deux1023 is 2^1023,
+ GCD is gcd(Deux1023,Val),
+ (GCD < Deux1023 ->
+ MaxP2 is protected_integer(floor_log2(GCD))
+ ; NVal is Val div Deux1023,
+ max_pow2_dividing(NVal,Deux1023,Deux1023,MaxP2)).
max_pow2_dividing(Val,Deux1023,AccuP2,MaxP2) :-
- GCD is gcd(Deux1023,Val),
- P2 is integer(floor_log2(GCD)),
- NAccuP2 is P2 + AccuP2,
- (GCD < Deux1023 ->
- MaxP2 is AccuP2 + integer(floor_log2(GCD))
- ; NVal is Val div Deux1023,
- NAccuP2 is AccuP2 + Deux1023,
- max_pow2_dividing(NVal,Deux1023,NAccuP2,MaxP2)).
+ GCD is gcd(Deux1023,Val),
+ P2 is protected_integer(floor_log2(GCD)),
+ NAccuP2 is P2 + AccuP2,
+ (GCD < Deux1023 ->
+ MaxP2 is AccuP2 + protected_integer(floor_log2(GCD))
+ ; NVal is Val div Deux1023,
+ NAccuP2 is AccuP2 + Deux1023,
+ max_pow2_dividing(NVal,Deux1023,NAccuP2,MaxP2)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% DIV
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-congr_div_directe(A,B,Q) :-
- B \== 0,
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- congr_div_directe(A,B,CA,MA,CB,MB,CQ,MQ,IQ),
- (nonvar(IQ) ->
- mfd:(Q :: IQ)
- ; true),
- launch_congr(Q,CQ,MQ).
+%congr_div_directe(real,A,B,Q) ?- !.
+congr_div_directe(Type,A,B,Q) :-
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ congr_div_directe(A,B,CA,MA,CB,MB,CQ,MQ,IQ),
+ ((Type == int,
+ nonvar(IQ))
+ ->
+ mfd:(Q :: IQ)
+ ; true),
+ launch_congr(Q,CQ,MQ).
-:- mode congr_div_directe(?,?,++,++,++,++,?,?,?).
+%:- mode congr_div_directe(?,?,++,++,++,++,?,?,?).
%% A et B constantes
congr_div_directe(_,_,CA,0,CB,0,CQ,MQ,IQ) ?- !,
- MQ = 0,
- IQ = [CQ],
- CQ is CA // CB.
+ MQ = 0,
+ IQ = [CQ],
+ CQ is CA // CB.
%% A ou B inconnues
congr_div_directe(_,_,0,1,_,_,CQ,MQ,_) ?- !,
- CQ = 0,
- MQ = 1.
+ CQ = 0,
+ MQ = 1.
congr_div_directe(_,_,_,_,0,1,CQ,MQ,_) ?- !,
- CQ = 0,
- MQ = 1.
+ CQ = 0,
+ MQ = 1.
congr_div_directe(A,B,CA,MA,CB,MB,CQ,MQ,IQ) :-
- %% Defini dans util.pl
- sign_of_int(A,SA),
- sign_of_int(B,SB),
- congr_div_directe_sign(SA,SB,CA,MA,CB,MB,CQ,MQ,IQ).
+ sign_of_int_real(A,SA),
+ sign_of_int_real(B,SB),
+ congr_div_directe_sign(SA,SB,CA,MA,CB,MB,CQ,MQ,IQ).
-:- mode congr_div_directe_sign(++,++,++,++,++,++,?,?,?).
congr_div_directe_sign(pos,SB,CA,MA,CB,MB,CQ,MQ,IQ) :-
- congr_div_directe_sign_posA(SB,CA,MA,CB,MB,CQ,MQ,IQ).
+ congr_div_directe_sign_posA(SB,CA,MA,CB,MB,CQ,MQ,IQ).
congr_div_directe_sign(neg,SB,CA,MA,CB,MB,CQ,MQ,IQ) :-
- congr_div_directe_sign_negA(SB,CA,MA,CB,MB,CQ,MQ,IQ).
+ congr_div_directe_sign_negA(SB,CA,MA,CB,MB,CQ,MQ,IQ).
congr_div_directe_sign(negpos,SB,CA,MA,CB,MB,CQ,MQ,IQ) :-
- congr_div_directe_sign_posA(SB,CA,MA,CB,MB,CQ1,MQ1,IQ1),
- (MQ1 == 1 ->
- CQ = 0,
- MQ = 1
- ; congr_div_directe_sign_negA(SB,CA,MA,CB,MB,CQ2,MQ2,IQ2),
- (MQ2 == 1 ->
- CQ = 0,
- MQ = 1
- ; union_congr(CQ1,CQ2,MQ1,MQ2,CQ,MQ,IQ3),
- ((var(IQ1);
- var(IQ2);
- var(IQ3))
- ->
- true
- ; append(IQ2,IQ2,IQ4),
- append(IQ1,IQ4,IQ)))).
+ congr_div_directe_sign_posA(SB,CA,MA,CB,MB,CQ1,MQ1,IQ1),
+ (MQ1 == 1 ->
+ CQ = 0,
+ MQ = 1
+ ; congr_div_directe_sign_negA(SB,CA,MA,CB,MB,CQ2,MQ2,IQ2),
+ (MQ2 == 1 ->
+ CQ = 0,
+ MQ = 1
+ ; union_congr(CQ1,CQ2,MQ1,MQ2,CQ,MQ,IQ3),
+ ((var(IQ1);
+ var(IQ2);
+ var(IQ3))
+ ->
+ true
+ ; append(IQ2,IQ2,IQ4),
+ append(IQ1,IQ4,IQ)))).
-:- mode congr_div_directe_sign_posA(++,++,++,++,++,?,?,?).
congr_div_directe_sign_posA(pos,CA,MA,CB,MB,CQ,MQ,_) :-
%% Pos x Pos
congr_div_directe_pp(CA,MA,CB,MB,CQ,MQ).
@@ -7697,7 +7918,6 @@ congr_div_directe_sign_posA(negpos,CA,MA,CB,MB,CQ,MQ,IQ) :-
CQ2 is - CQ02),
union_congr(CQ1,CQ2,MQ1,MQ2,CQ,MQ,IQ)).
-:- mode congr_div_directe_sign_negA(++,++,++,++,++,?,?,?).
congr_div_directe_sign_negA(pos,CA,MA,CB,MB,CQ,MQ,_) :-
%% Neg x Pos
OpCA is - CA,
@@ -7747,151 +7967,152 @@ congr_div_directe_pp(_,_,_,_,0,1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% MOD
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-congr_mod_directe(A,B,R) :-
- B \== 0,
- get_congr(A,CA,MA),
- get_congr(B,CB,MB),
- congr_mod_directe(A,B,CA,MA,CB,MB,CR,MR,IR),
- (nonvar(IR) ->
- mfd:(R :: IR)
- ; true),
- launch_congr(R,CR,MR).
+%congr_mod_directe(real,A,B,R) ?- !.
+congr_mod_directe(Type,A,B,R) :-
+ get_congr(A,CA,MA),
+ get_congr(B,CB,MB),
+ congr_mod_directe(A,B,CA,MA,CB,MB,CR,MR,IR),
+ ((Type == int,
+ nonvar(IR))
+ ->
+ mfd:(R :: IR)
+ ; true),
+ launch_congr(R,CR,MR).
-:- mode congr_mod_directe(?,?,++,++,++,++,?,?,?).
+%:- mode congr_mod_directe(?,?,++,++,++,++,?,?,?).
%% A et B constantes
congr_mod_directe(_,_,CA,0,CB,0,CR,0,[CR]) :- !,
- CR is CA rem CB.
+ CR is CA rem CB.
%% A ou B inconnues
congr_mod_directe(_,_,0,1,_,_,0,1,_) :- !.
congr_mod_directe(_,_,_,_,0,1,0,1,_) :- !.
congr_mod_directe(A,B,CA,MA,CB,MB,CR,MR,IR) :-
- sign_of_int(A,SA),
- sign_of_int(B,SB),
- congr_mod_directe_sign(SA,SB,CA,MA,CB,MB,CR,MR,IR).
+ sign_of_int_real(A,SA),
+ sign_of_int_real(B,SB),
+ congr_mod_directe_sign(SA,SB,CA,MA,CB,MB,CR,MR,IR).
:- mode congr_mod_directe_sign(++,++,++,++,++,++,?,?,?).
congr_mod_directe_sign(pos,SB,CA,MA,CB,MB,CR,MR,IR) :-
- congr_mod_directe_sign_posA(SB,CA,MA,CB,MB,CR,MR,IR).
+ congr_mod_directe_sign_posA(SB,CA,MA,CB,MB,CR,MR,IR).
congr_mod_directe_sign(neg,SB,CA,MA,CB,MB,CR,MR,IR) :-
- congr_mod_directe_sign_negA(SB,CA,MA,CB,MB,CR,MR,IR).
+ congr_mod_directe_sign_negA(SB,CA,MA,CB,MB,CR,MR,IR).
congr_mod_directe_sign(negpos,SB,CA,MA,CB,MB,CR,MR,IR) :-
- congr_mod_directe_sign_posA(SB,CA,MA,CB,MB,CR1,MR1,IR1),
- (MR1 == 1 ->
- CR = 0,
- MR = 1
- ; congr_mod_directe_sign_negA(SB,CA,MA,CB,MB,CR2,MR2,IR2),
- (MR2 == 1 ->
- CR = 0,
- MR = 1
- ; union_congr(CR1,CR2,MR1,MR2,CR,MR,IR3),
- ((var(IR1);
- var(IR2);
- var(IR3))
- ->
- true
- ; append(IR2,IR3,IR4),
- append(IR1,IR4,IR)))).
+ congr_mod_directe_sign_posA(SB,CA,MA,CB,MB,CR1,MR1,IR1),
+ (MR1 == 1 ->
+ CR = 0,
+ MR = 1
+ ; congr_mod_directe_sign_negA(SB,CA,MA,CB,MB,CR2,MR2,IR2),
+ (MR2 == 1 ->
+ CR = 0,
+ MR = 1
+ ; union_congr(CR1,CR2,MR1,MR2,CR,MR,IR3),
+ ((var(IR1);
+ var(IR2);
+ var(IR3))
+ ->
+ true
+ ; append(IR2,IR3,IR4),
+ append(IR1,IR4,IR)))).
:- mode congr_mod_directe_sign_posA(++,++,++,++,++,?,?,?).
congr_mod_directe_sign_posA(pos,CA,MA,CB,MB,CR,MR,_) :-
- %% Pos x Pos
- congr_mod_directe_pp(CA,MA,CB,MB,CR,MR).
+ % Pos x Pos
+ congr_mod_directe_pp(CA,MA,CB,MB,CR,MR).
congr_mod_directe_sign_posA(neg,CA,MA,CB,MB,CR,MR,_) :-
- %% Pos x Neg
- OpCB is - CB,
- congr_mod_directe_pp(CA,MA,OpCB,MB,CR,MR).
+ % Pos x Neg
+ OpCB is - CB,
+ congr_mod_directe_pp(CA,MA,OpCB,MB,CR,MR).
congr_mod_directe_sign_posA(negpos,CA,MA,CB,MB,CR,MR,IR) :-
- %% Pos x Pos
- congr_mod_directe_pp(CA,MA,CB,MB,CR1,MR1),
- (MR1 == 1 ->
- CR = 0,
- MR = 1
- ; %% Pos x Neg
- (CB == 0 ->
- CR2 = CR1,
- MR2 = MR1
- ; OpCB is - CB,
- congr_mod_directe_pp(CA,MA,OpCB,MB,CR2,MR2)),
- union_congr(CR1,CR2,MR1,MR2,CR,MR,IR)).
+ % Pos x Pos
+ congr_mod_directe_pp(CA,MA,CB,MB,CR1,MR1),
+ (MR1 == 1 ->
+ CR = 0,
+ MR = 1
+ ; % Pos x Neg
+ (CB == 0 ->
+ CR2 = CR1,
+ MR2 = MR1
+ ; OpCB is - CB,
+ congr_mod_directe_pp(CA,MA,OpCB,MB,CR2,MR2)),
+ union_congr(CR1,CR2,MR1,MR2,CR,MR,IR)).
:- mode congr_mod_directe_sign_negA(++,++,++,++,++,?,?,?).
congr_mod_directe_sign_negA(pos,CA,MA,CB,MB,CR,MR,_) :-
- %% Neg x Pos
- OpCA is - CA,
- congr_mod_directe_pp(OpCA,MA,CB,MB,OpCR,MR),
- CR is - OpCR.
+ % Neg x Pos
+ OpCA is - CA,
+ congr_mod_directe_pp(OpCA,MA,CB,MB,OpCR,MR),
+ CR is - OpCR.
congr_mod_directe_sign_negA(neg,CA,MA,CB,MB,CR,MR,_) :-
- %% Neg x Neg
- OpCA is - CA,
- OpCB is - CB,
- congr_mod_directe_pp(OpCA,MA,OpCB,MB,OpCR,MR),
- CR is - OpCR.
+ % Neg x Neg
+ OpCA is - CA,
+ OpCB is - CB,
+ congr_mod_directe_pp(OpCA,MA,OpCB,MB,OpCR,MR),
+ CR is - OpCR.
congr_mod_directe_sign_negA(negpos,CA,MA,CB,MB,CR,MR,IR) :-
- %% Neg x Pos
- OpCA is - CA,
- congr_mod_directe_pp(OpCA,MA,CB,MB,CR03,MR3),
- (MR3 == 1 ->
- CR = 0,
- MR = 1
- ; CR3 is - CR03,
- %% Neg x Neg
- (CB == 0 ->
- CR4 = CR3,
- MR4 = MR3
- ; OpCB is - CB,
- congr_mod_directe_pp(OpCA,MA,OpCB,MB,CR04,MR4),
- CR4 is - CR04),
- union_congr(CR3,CR4,MR3,MR4,CR,MR,IR)).
-
-
-
+ % Neg x Pos
+ OpCA is - CA,
+ congr_mod_directe_pp(OpCA,MA,CB,MB,CR03,MR3),
+ (MR3 == 1 ->
+ CR = 0,
+ MR = 1
+ ; CR3 is - CR03,
+ % Neg x Neg
+ (CB == 0 ->
+ CR4 = CR3,
+ MR4 = MR3
+ ; OpCB is - CB,
+ congr_mod_directe_pp(OpCA,MA,OpCB,MB,CR04,MR4),
+ CR4 is - CR04),
+ union_congr(CR3,CR4,MR3,MR4,CR,MR,IR)).
:- mode congr_mod_directe_pp(++,++,++,++,?,?).
%% A constante
congr_mod_directe_pp(CA,0,CB,MB,CR,MR) :- !,
- M is ((CA - CB) div MB) - ((- CB) div MB),
- (M == 0 ->
- CR = CA,
- MR = 0
- ; CR = CA,
- (M == 1 ->
- N is CA - ((CA - CB) mod MB),
- MR is N*(CA div N)
- ; %% M >= 2
- MR is gcd(CA,MB))).
+ M is ((CA - CB) div MB) - ((- CB) div MB),
+ (M == 0 ->
+ CR = CA,
+ MR = 0
+ ; CR = CA,
+ (M == 1 ->
+ N is CA - ((CA - CB) mod MB),
+ MR is N*(CA div N)
+ ; % M >= 2
+ MR is gcd(CA,MB))).
%% B constante
congr_mod_directe_pp(CA,MA,CB,0,CR,MR) :- !,
%% (CB mod MA =:= 0 ->
- (MA mod CB =:= 0 ->
- CR is CA rem CB,
- MR = 0
- ; CR = CA,
- MR is gcd(MA,CB)).
+ (MA mod CB =:= 0 ->
+ CR is CA rem CB,
+ MR = 0
+ ; CR = CA,
+ MR is gcd(MA,CB)).
%% Cas normal
congr_mod_directe_pp(CA,MA,CB,MB,CA,MR) :-
- MR is gcd(gcd(MA,MB),CB).
+ MR is gcd(gcd(MA,MB),CB).
-sign_of_int(A,SA) :-
- mfd:dvar_range(A,MinA,MaxA),
- (MinA >= 0 ->
- SA = pos
- ; (MaxA < 0 ->
- SA = neg
- ; SA = negpos)).
+sign_of_int_real(A,SA) :-
+ (get_type(A,int) ->
+ mfd:dvar_range(A,MinA,MaxA)
+ ; mreal:dvar_range(A,MinA,MaxA)),
+ (MinA >= 0 ->
+ SA = pos
+ ; (MaxA < 0 ->
+ SA = neg
+ ; SA = negpos)).
%% Pour compenser le bug de eclipse
%% sur les grands entiers
pow_int(A,0,1) :- !.
pow_int(A,1,A) :- !.
pow_int(A,N,AN) :-
- N >= 2,!,
- NN is N div 2,
- pow_int(A,NN,ANN),
- A2NN is ANN*ANN,
- (mod(N,2,0) ->
- AN = A2NN
- ; AN is A*A2NN).
+ N >= 2,!,
+ NN is N div 2,
+ pow_int(A,NN,ANN),
+ A2NN is ANN*ANN,
+ (mod(N,2,0) ->
+ AN = A2NN
+ ; AN is A*A2NN).
diff --git a/Src/COLIBRI/arith_sched.pl b/Src/COLIBRI/arith_sched.pl
index e59c4f8dd4fbd56e724d1f6a1dff40c5fa7dddb5..62fd483f804ecb8d33e87a382687d8f27050e00a 100755
--- a/Src/COLIBRI/arith_sched.pl
+++ b/Src/COLIBRI/arith_sched.pl
@@ -32,7 +32,7 @@ set_touched_arg_from_goal(add_int(A,TA,B,TB,C,TC),Var,S) :- !,
change_prio_if_inst_arg(NInst,2,S,2,4).
-set_touched_arg_from_goal(add_real1(_,A,B,C),Var,S) :- !,
+set_touched_arg_from_goal(add_real1(_,A,B,C),_Var,S) :- !,
term_variables((A,B,C),L),
NInst0 is 3 - length(L),
((is_fzero(A);
@@ -63,7 +63,7 @@ set_touched_arg_from_goal(mult_int(A,TA,B,TB,C,TC),Var,S) :- !,
; NInst = NInst0),
change_prio_if_inst_arg(NInst,2,S,2,4).
-set_touched_arg_from_goal(mult_real1(_,A,B,C),Var,S) :- !,
+set_touched_arg_from_goal(mult_real1(_,A,B,C),_Var,S) :- !,
term_variables((A,B,C),L),
NInst0 is 3 - length(L),
((is_fzero(A);
@@ -81,7 +81,7 @@ set_touched_arg_from_goal(mult_real1(_,A,B,C),Var,S) :- !,
NInst = NInst0),
change_prio_if_inst_arg(NInst,2,S,LP,4).
-set_touched_arg_from_goal(div_mod_int(A,B,C,_BC,R),Var,S) :- !,
+set_touched_arg_from_goal(div_mod_int(A,B,C,_BC,R),_Var,S) :- !,
term_variables((A,B,C,R),L),
NInst0 is 4 - length(L),
((A == 0;
@@ -96,7 +96,7 @@ set_touched_arg_from_goal(div_mod_int(A,B,C,_BC,R),Var,S) :- !,
; LP = 3,
NInst = NInst0),
change_prio_if_inst_arg(NInst,2,S,LP,4).
-set_touched_arg_from_goal(div_real1(_,A,B,C),Var,S) :- !,
+set_touched_arg_from_goal(div_real1(_,A,B,C),_Var,S) :- !,
term_variables((A,B,C),L),
NInst0 is 3 - length(L),
((is_fzero(A);
@@ -114,79 +114,79 @@ set_touched_arg_from_goal(div_real1(_,A,B,C),Var,S) :- !,
change_prio_if_inst_arg(NInst,2,S,LP,4).
set_touched_arg_from_goal(power_int(A,TA,_,B,TB),Var,S) :- !,
- instantiate_flag([(A,TA),(B,TB)],Var,0,NInst),
- change_prio_if_inst_arg(NInst,1,S,2,3).
+ instantiate_flag([(A,TA),(B,TB)],Var,0,NInst),
+ change_prio_if_inst_arg(NInst,1,S,2,3).
-set_touched_arg_from_goal(op_int(A,B),Var,S) :- !,
- (nonvar(A) ->
- (nonvar(B) ->
- B is -A
- ; change_prio_if_not_RC(S,2))
- ; ((nonvar(B);
- A == B)
- ->
- change_prio_if_not_RC(S,2)
- ; true)).
-set_touched_arg_from_goal(op_real(_,A,B),Var,S) :- !,
- (nonvar(A) ->
- (nonvar(B) ->
- B is -A
- ; change_prio_if_not_RC(S,2))
- ; ((nonvar(B);
- A == B)
- ->
- change_prio_if_not_RC(S,2)
- ; true)).
+set_touched_arg_from_goal(op_int(A,B),_Var,S) :- !,
+ (nonvar(A) ->
+ (nonvar(B) ->
+ B is -A
+ ; change_prio_if_not_RC(S,2))
+ ; ((nonvar(B);
+ A == B)
+ ->
+ change_prio_if_not_RC(S,2)
+ ; true)).
+set_touched_arg_from_goal(op_real(_,A,B),_Var,S) :- !,
+ (nonvar(A) ->
+ (nonvar(B) ->
+ B is -A
+ ; change_prio_if_not_RC(S,2))
+ ; ((nonvar(B);
+ A == B)
+ ->
+ change_prio_if_not_RC(S,2)
+ ; true)).
-set_touched_arg_from_goal(abs_val_int(A,B),Var,S) :- !,
- ((nonvar(A);
- nonvar(B);
- A == B)
- ->
- change_prio_if_not_RC(S,2)
- ; true).
+set_touched_arg_from_goal(abs_val_int(A,B),_Var,S) :- !,
+ ((nonvar(A);
+ nonvar(B);
+ A == B)
+ ->
+ change_prio_if_not_RC(S,2)
+ ; true).
-set_touched_arg_from_goal(geq(A,B),Var,S) :- !,
- (A == B ->
- kill_suspension(S)
- ; ((nonvar(A);
- nonvar(B))
- ->
- change_prio_if_not_RC(S,2)
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- ((MinA < MinB;
- MaxA < MaxB)
- ->
- change_prio_if_not_RC(S,3)
- ; true))).
+set_touched_arg_from_goal(geq(A,B),_Var,S) :- !,
+ (A == B ->
+ kill_suspension(S)
+ ; ((nonvar(A);
+ nonvar(B))
+ ->
+ change_prio_if_not_RC(S,2)
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ ((MinA < MinB;
+ MaxA < MaxB)
+ ->
+ change_prio_if_not_RC(S,3)
+ ; true))).
-set_touched_arg_from_goal(gt(A,B),Var,S) :- !,
- %% pour echouer plus vite
- A \== B,
- ((nonvar(A);
- nonvar(B))
- ->
- change_prio_if_not_RC(S,2)
- ; mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- ((MinA =< MinB;
- MaxA =< MaxB)
- ->
- change_prio_if_not_RC(S,3)
- ; true)).
+set_touched_arg_from_goal(gt(A,B),_Var,S) :- !,
+ % pour echouer plus vite
+ A \== B,
+ ((nonvar(A);
+ nonvar(B))
+ ->
+ change_prio_if_not_RC(S,2)
+ ; mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ ((MinA =< MinB;
+ MaxA =< MaxB)
+ ->
+ change_prio_if_not_RC(S,3)
+ ; true)).
-set_touched_arg_from_goal(diff_int(A,B),Var,S) :- !,
- %% pour echouer plus vite
- A \== B,
- ((nonvar(A);
- nonvar(B))
- ->
- change_prio_if_not_RC(S,2)
- ; true).
+set_touched_arg_from_goal(diff_int(A,B),_Var,S) :- !,
+ % pour echouer plus vite
+ A \== B,
+ ((nonvar(A);
+ nonvar(B))
+ ->
+ change_prio_if_not_RC(S,2)
+ ; true).
-set_touched_arg_from_goal(geq_real(_,A,B),Var,S) :- !,
+set_touched_arg_from_goal(geq_real(_,A,B),_Var,S) :- !,
(A == B ->
kill_suspension(S)
; ((is_fzero(A);
@@ -197,7 +197,7 @@ set_touched_arg_from_goal(geq_real(_,A,B),Var,S) :- !,
change_prio_if_not_RC(S,2)
; true)).
-set_touched_arg_from_goal(gt_real(_,A,B),Var,S) :- !,
+set_touched_arg_from_goal(gt_real(_,A,B),_Var,S) :- !,
% pour echouer plus vite
A \== B,
((is_fzero(A);
@@ -208,7 +208,7 @@ set_touched_arg_from_goal(gt_real(_,A,B),Var,S) :- !,
change_prio_if_not_RC(S,2)
; true).
-set_touched_arg_from_goal(diff_real(_,A,B),Var,S) :- !,
+set_touched_arg_from_goal(diff_real(_,A,B),_Var,S) :- !,
% pour echouer plus vite
A \== B,
((is_fzero(A);
diff --git a/Src/COLIBRI/check_ineq.pl b/Src/COLIBRI/check_ineq.pl
index 3e0b0311211c84eaa7b5f768a8e36255ea389d12..ac37081170c483fb8b393bdc26b0a4d7736c2aa7 100644
--- a/Src/COLIBRI/check_ineq.pl
+++ b/Src/COLIBRI/check_ineq.pl
@@ -90,7 +90,7 @@ check_deltas_add_with_same_cst_arg(Cst,Arg,Res) :-
OSeen = [Susp|ISeen]
; OSeen = ISeen)).
-%%launch_delta_add_res_inst(A,B,C) :- !.
+%launch_delta_add_res_inst(A,B,C) :- !.
launch_delta_add_res_inst(A,B,C) :-
% A = B + C
% B + 2C-A = C --> B + 2(MinC..MaxC)-A = C
@@ -190,16 +190,27 @@ update_var_from_delta_rel('+',DistAC,B,A,C) :-
% pas de notify_constrained
mfd:quiet_set_intervals(B,[DistAC]).
-%% Mise a jour du range de A et B de maniere
+%% Mise a jour du range de A ou B de maniere
%% compatible avec leur delta
+%% On ne sait rien faire de correct si A et B variables
%% On ne retourne pas de Rel/Delta si il y a des congruences
%% sur A et B car elles ne sont pas gerees dans la composition
%% des intervalles compatibles de A et B pour ajuster les bornes
%% (on pourrait alors provoquer des convergences lentes)
-% FAUX !!!
-% PROVOQUE DES BUGS DANS div_mod_rec
-update_args_from_delta(?,?,A,B) :- !.
+% NE SERT PLUS A RIEN/ pas delta si A ou B instancié et on ne
+% sait rien réduire si deux variables
+update_args_from_delta(Rel,Delta,A,B) :-
+ var(A),
+ var(B),
+ !,
+ (var(Rel) ->
+ Rel = ?
+ ; true),
+ (var(Delta) ->
+ Delta = ?
+ ; true).
+% A ou B instancié
update_args_from_delta(Rel,Delta,A,B) :-
update_args_from_delta0(Rel0,Delta0,A,B),
((nonvar(Rel),
@@ -216,6 +227,7 @@ update_args_from_delta(Rel,Delta,A,B) :-
; Rel = Rel0,
Delta = Delta0)).
+%update_args_from_delta0(Rel,Delta,A,B) :- !.
update_args_from_delta0(Rel,Delta,A,A) ?- !,
Rel = '=',
Delta = 0.
@@ -320,9 +332,11 @@ update_A_B_from_delta_diff(Delta,MinA,MaxA,MinB,MaxB,NMinA,NMaxA,NMinB,NMaxB) :-
update_A_B_from_delta(0,MinA,MaxA,MinB,MaxB,MinA,MaxA,MinB,MaxB) :- !.
update_A_B_from_delta(Delta,A,A,MinB,MaxB,NMinA,NMaxA,NMinB,NMaxB) ?- !,
+ % A instancié
NMinA = A,
NMaxA = A,
min_max_inter(Delta,L,H),
+ % B instancié
(MinB == MaxB ->
A + L =< MinB,
MinB =< A + H,
@@ -331,12 +345,16 @@ update_A_B_from_delta(Delta,A,A,MinB,MaxB,NMinA,NMaxA,NMinB,NMaxB) ?- !,
; NMinB is max(MinB,A + L),
NMaxB is min(MaxB,A + H)).
update_A_B_from_delta(Delta,MinA,MaxA,B,B,NMinA,NMaxA,NMinB,NMaxB) ?- !,
+ % B instancié
NMinB = B,
NMaxB = B,
min_max_inter(Delta,L,H),
% MinA < MaxA
NMinA is max(MinA,B - H),
NMaxA is min(MaxA,B - L).
+update_A_B_from_delta(Delta,MinA,MaxA,MinB,MaxB,MinA,MaxA,MinB,MaxB).
+/*
+% FAUX: on ne sait pas réduire A ou B dans ce cas !!!
update_A_B_from_delta(Delta,MinA,MaxA,MinB,MaxB,NMinA,NMaxA,NMinB,NMaxB) :-
% MinA..MaxA + L..H = MinB..MaxB sans toucher L..H
add_intervals(MinA..MaxA,Delta,MinB0,MaxB0),
@@ -348,7 +366,7 @@ update_A_B_from_delta(Delta,MinA,MaxA,MinB,MaxB,NMinA,NMaxA,NMinB,NMaxB) :-
; minus_intervals(NMinB..NMaxB,Delta,MinA0,MaxA0),
NMinA is max(MinA,MinA0),
NMaxA is min(MaxA,MaxA0)).
-
+*/
diff --git a/Src/COLIBRI/check_lin_expr.pl b/Src/COLIBRI/check_lin_expr.pl
index 802dfb94cafd4cf299326e7551367475c914a778..e2983a56d4797c6a70bf66eeb1c8556b93eeaa58 100755
--- a/Src/COLIBRI/check_lin_expr.pl
+++ b/Src/COLIBRI/check_lin_expr.pl
@@ -14,11 +14,13 @@ check_exists_lin_expr_giving_diff_args(Type,A,B,Stop) :-
once (var(A);
var(B)),
!,
-
- (timeout(try_check_exists_lin_expr_giving_diff_args(Type,A,B,Stop),
+ (block(timeout(try_check_exists_lin_expr_giving_diff_args(Type,A,B,Stop),
0.5,
%1.0Inf,
- true)
+ true),
+ Tag,
+ (call(spy_here)@eclipse,
+ try_check_exists_lin_expr_giving_diff_args(Type,A,B,Stop)))
->
true
; getval(gdbg,1)@eclipse,
@@ -102,7 +104,9 @@ try_check_exists_lin_expr_giving_diff_args(Type,A,B,Stop) :-
mfd:dvar_remove_element(Other,Val),
Stop = 1
; % real
- (is_float_number(Other) ->
+ ((not_inf_bounds(Other), % prudence pour p(Inf) ou s(-Inf)
+ is_float_number(Other))
+ ->
mreal:dvar_remove_element(Other,Val),
Stop = 1
; true))
@@ -160,8 +164,8 @@ reduce_var_from_rat_interval(Type,A,R) :-
(number(R) ->
(Type == int ->
% on peut echouer ici
- denominator(R,1),
- numerator(R,NR),
+ protected_denominator(R,1),
+ protected_numerator(R,NR),
protected_unify(A,NR)
; float_of_rat(real,rtn,R,L),
float_of_rat(real,rtp,R,H),
@@ -172,8 +176,8 @@ reduce_var_from_rat_interval(Type,A,R) :-
(Type == int ->
% on peut etre deux bornes non entieres
% on garde les entiers a l'interieur
- L is numerator(ceiling(RL)),
- H is numerator(floor(RH)),
+ L is protected_numerator(ceiling(RL)),
+ H is protected_numerator(floor(RH)),
L =< H,
mfd:set_intervals(A,[L..H])
; (RL == -1.0Inf ->
@@ -307,15 +311,15 @@ protected_rat_add(A,B,C) :-
:- export get_congr_from_lin_expr/4.
get_congr_from_lin_expr(Sum,C,R,Mod) :-
- denominator(C,1),
- numerator(C,IC),
+ protected_denominator(C,1),
+ protected_numerator(C,IC),
congr_sum(Sum,IC,0,R,Mod).
congr_sum([],C,M,C,M).
congr_sum([Coeff*Var|Sum],C0,M0,NC,NM) :-
- denominator(Coeff,1),
+ protected_denominator(Coeff,1),
get_congr(Var,CV,MV),
- numerator(Coeff,ICoeff),
+ protected_numerator(Coeff,ICoeff),
congr_mult(CV,MV,0,ICoeff,C1,M1),
congr_add(C1,M1,C0,M0,C,M),
congr_sum(Sum,C,M,NC,NM).
@@ -390,8 +394,8 @@ get_args_from_add_mult_giving(Type,V,From,NLArgs) :-
fromto([],IL,OL,NLArgs),
param(From) do
term_variables(Expr,Vars),
- ((member(V,Vars),
- occurs(V,From))
+ ((member(Var,Vars),
+ occurs(Var,From))
->
OL = IL
; OL = [Expr|IL])),
@@ -496,12 +500,14 @@ get_args_from_other_add_op_mult(Type,LC,V,LArgs) :-
(V == X,
% X = Z * 1/Y
number(Y),
+ not_zero(Y),
rational(Y,RY),
InvY is 1_1/RY,
OLArgs = [[InvY*Z]|ILArgs];
V == Y,
% Y = Z * 1/X
number(X),
+ not_zero(X),
rational(X,RX),
InvX is 1_1/RX,
OLArgs = [[InvX*Z]|ILArgs]))
@@ -525,12 +531,14 @@ get_args_from_other_add_op_mult(Type,LC,V,LArgs) :-
% et on peut inverser sur X ou Y
(V == X,
number(Y),
+ not_zero(Y),
% X = Z * 1/Y
rational(Y,RY),
InvY is 1_1/RY,
Args = [InvY*Z];
V == Y,
number(X),
+ not_zero(X),
% Y = Z * 1/X
rational(X,RX),
InvX is 1_1/RX,
diff --git a/Src/COLIBRI/col_solve.pl b/Src/COLIBRI/col_solve.pl
index 09c49b9a69ba3c3424899826e2de025570a3353a..8e6127866001222253ab733633e2832ff1dc0806 100644
--- a/Src/COLIBRI/col_solve.pl
+++ b/Src/COLIBRI/col_solve.pl
@@ -1,3 +1,4 @@
+
:- pragma(nowarnings).
%% Rend le compilateur silencieux
@@ -18,8 +19,8 @@
%% Warning "already reexported"
:- set_event_handler(90,true/0).
-%:- set_flag(variable_names,off).
-
+:- set_flag(variable_names,off).
+%:- set_flag(variable_names,check_singletons).
:- lib(lists).
:- lib(timeout).
@@ -627,6 +628,7 @@ smt_solve_bis0(Test,FILE,TO,Code) :-
->
getval(diag_code,(Diag,Code))
; % echec a la propagation
+ getval(smt_status,Status)@eclipse,
(Status == sat ->
Code = 2,
Diag = unknown,
@@ -688,19 +690,45 @@ is_decl(array_vars(_,_,_)) ?- !.
% pour check_sat_vars
save_goal_before_check_sat(Goal) :-
+ garbage_collect,!,
+ true,
goal_before_check_sat(Goal,NGoal0),
get_type_decl(NGoal0,Decl,NGoal),
- % Les variables de Decl sont attribuees
- % par leur type
- call(Decl),
+% call(Decl),
+ keep_ground_goals(NGoal,NGoal1,GCG,EGCG),
+ term_variables(NGoal1,LVars),
% Les CGVars ne contiennent que des variables
% attribuees (donc celles de Decl normalement ?)
- copy_term(NGoal,CG,CGVars),
+% copy_term(NGoal1,CNGoal1,CGVars),
+
+ setval(cgoals,NGoal1),
+ getval(cgoals,CNGoal1),
+% copy_term(NGoal1,CNGoal1),
+ term_variables(CNGoal1,CLVars),
+ call(Decl),
+ (foreach(MV,LVars),
+ foreach(CV,CLVars),
+ fromto([],ITV,OTV,TCGVars) do
+ (get_variable_type(MV,Type) ->
+ OTV = [(MV,Type,CV)|ITV]
+ ; OTV = ITV)),
+% protected_unify(CNGoal1,EGCG),
+/*
(foreach([V|CV],CGVars),
foreach((V,Type,CV),TCGVars) do
get_variable_type(V,Type)),
- setval(gsat,CG-TCGVars).
-
+*/
+% setval(gsat,GCG-TCGVars).
+ setval(gsat,CNGoal1-TCGVars).
+
+keep_ground_goals([G|Goals],NGoals,GrGoals,EndGrGoals) ?- !,
+ (ground(G) ->
+ GrGoals = [G|EGrGoals],
+ keep_ground_goals(Goals,NGoals,EGrGoals,EndGrGoals)
+ ; NGoals = [G|ENGoals],
+ keep_ground_goals(Goals,ENGoals,GrGoals,EndGrGoals)).
+keep_ground_goals([],[],EndGrGoals,EndGrGoals).
+
initNbCodes :-
setval(nbFile,0),
setval(nb0,0),
@@ -770,32 +798,66 @@ smt_test_CI(TO,Size) :-
smt_test(TO,Size,CI) :-
%StrDir = "./colibri_tests/colibri/tests/",
- %StrDir = "./colibri_tests/colibri/tests/sat/", %0 (sans real/float->int!) des TOs sur
- % newton en CI à 15s mais pas à 20s
- StrDir = "./colibri_tests/colibri/tests/unsat/", %0
+ %StrDir = "./colibri_tests/colibri/tests/sat/",
+ % 0 (sans real/float->int!) 1 TO sur newton à 15s mais pas a 24s
+
+ %StrDir = "./colibri_tests/colibri/tests/unsat/", %0
%StrDir = "./colibri_tests/colibri/tests/unknown/",
%StrDir = "./colibri_tests/colibri/tests/timeout/",
+ %StrDir = "./QF_LIA_sat/20180326-Bromberger/unbd-sage/unbd010v15c/",
+ % 25/25 TO (15s)
+ %StrDir = "./QF_LIA_sat/arctic-matrix/",% 100/100
+ %StrDir = "./QF_LIA_sat/Averest/", % 13/19
+ %StrDir = "./QF_LIA_sat/bofill-scheduling/", % 652/652
+ %StrDir = "./QF_LIA_sat/calypto/", % 5/37
+ %StrDir = "./QF_LIA_sat/CAV_2009_benchmarks/coef-size/smt/size-10/",
+ % 5/6 TO
+ %StrDir = "./QF_LIA_sat/CIRC/", % 25/51
+ %StrDir = "./QF_LIA_sat/convert/", % 2/319
+ %StrDir = "./QF_LIA_sat/cut_lemmas/", % 90/93
+ %StrDir = "./QF_LIA_sat/dillig/", % 212/233
+ %StrDir = "./QF_LIA_sat/fft/", % 7/9
+ %StrDir = "./QF_LIA_sat/mathsat/", % 80/121
+ %StrDir = "./QF_LIA_sat/miplib2003/", % 16/16
+ %StrDir = "./QF_LIA_sat/nec-smt/small/", % 6/35
+ %StrDir = "./QF_LIA_sat/nec-smt/med/", % 343/364
+ %StrDir = "./QF_LIA_sat/nec-smt/large/", % 2376/2381
+ %StrDir = "./QF_LIA_sat/pb2010/", % 80/81
+ %StrDir = "./QF_LIA_sat/pidgeons/", % 13/19
+ %StrDir = "./QF_LIA_sat/prime-cone/", % 25/37
+ %StrDir = "./QF_LIA_sat/rings/", % 278/294
+ %StrDir = "./QF_LIA_sat/rings_preprocessed/", % 294/294
+ %StrDir = "./QF_LIA_sat/RTCL/", % 0/2
+ %StrDir = "./QF_LIA_sat/RWS/", % 10/10 (10 Ignored)
+ %StrDir = "./QF_LIA_sat/slacks/", % 221/233
+ %StrDir = "./QF_LIA_sat/tightrhombus/", % 22/22
+ %StrDir = "./QF_LIA_sat/tropical-matrix/", % 13/13 (95 Ignored)
+ %StrDir = "./QF_LIA_sat/wisa/", % 5/5
+ %StrDir = "./QF_LIA_sat/check/", % 0/5
+
%StrDir = "./smt/",
%StrDir = "./AdaCore/",
%StrDir = "./AdaCore/smt/",
- %StrDir = "./QF_LRA/2017-Heizmann-UltimateInvariantSynthesis/",
- %StrDir = "./QF_LRA/DTP-Scheduling/",
- %StrDir = "./QF_LRA/LassoRanker/",
- %StrDir = "./QF_LRA/latendresse/",
- %StrDir = "./QF_LRA/miplib/",
- %StrDir = "./QF_LRA/check/", %OK
- %StrDir = "./QF_LRA/keymaera/", %OK
- %StrDir = "./QF_LRA/meti-tarski/", %OK
- %StrDir = "./QF_LRA/sal/",
- %StrDir = "./QF_LRA/sc/",
+ %StrDir = "./QF_LRA/2017-Heizmann-UltimateInvariantSynthesis/",
+ % 29/29 (29 I)
+ %StrDir = "./QF_LRA/DTP-Scheduling/", % 84/86 (5 I)
+ %StrDir = "./QF_LRA/LassoRanker/", % 31/31 (389 I)
+ %StrDir = "./QF_LRA/latendresse/", % 10/10 (8 I)
+ %StrDir = "./QF_LRA/miplib/", % 40/42
- %StrDir = "./QF_LRA/spider_benchmarks/",
- %StrDir = "./QF_LRA/TM/",
- %StrDir = "./QF_LRA/tropical-matrix/",
- %StrDir = "./QF_LRA/uart/",
- %StrDir = "./QF_LRA/tta_startup/",
+ %StrDir = "./QF_LRA/check/", % 0/2
+ %StrDir = "./QF_LRA/keymaera/", % 0/21
+ %StrDir = "./QF_LRA/meti-tarski/", % 0/31
+ %StrDir = "./QF_LRA/sal/", % 34/107
+ %StrDir = "./QF_LRA/sc/", % 122/144
+
+ %StrDir = "./QF_LRA/spider_benchmarks/", % 22/42
+ %StrDir = "./QF_LRA/TM/", % 10/10 (15 I)
+ %StrDir = "./QF_LRA/tropical-matrix/", % 6/6 (4 Ignored)
+ %StrDir = "./QF_LRA/uart/", % 73/73
+ %StrDir = "./QF_LRA/tta_startup/", % 48/72
%StrDir = "./smtlib_schanda-master/crafted/",
%StrDir = "./smtlib_schanda-master/crafted/QF_FP/",
@@ -827,61 +889,62 @@ smt_test(TO,Size,CI) :-
%StrDir = "./totest/",
%StrDir = "./AdaCore/",
%------------------------------------------------------------------------
+% TOUT EN 15s
+
%StrDir = "./QF_BV/",
%StrDir = "./QF_BV/20170501-Heizmann-UltimateAutomizer/",% 0
%StrDir = "./QF_BV/20170531-Hansen-Check/", % 0
%StrDir = "./QF_BV/2017-BuchwaldFried/",% 3/4
- %StrDir = "./QF_BV/2018-Goel-hwbench/",% 11/11
+ %StrDir = "./QF_BV/2018-Goel-hwbench/",% 7/54
%StrDir = "./QF_BV/2019-Mann/",% 2/2
%StrDir = "./QF_BV/2019-Wolf-fmbench/",% 14/14
%StrDir = "./QF_BV/20200415-Yurichev/",% 1/1
- %StrDir = "./QF_BV/bmc-bv-svcomp14/",% 14/32
+ %StrDir = "./QF_BV/bmc-bv-svcomp14/",% 16/32
%StrDir = "./QF_BV/calypto/",% 20/23
- %StrDir = "./QF_BV/challenge/",% 1/2
+ %StrDir = "./QF_BV/challenge/",% 2/2
%StrDir = "./QF_BV/check2/",% 0/6
%StrDir = "./QF_BV/dwp_formulas/",% 0/332
%StrDir = "./QF_BV/ecc/", % 7/8
- %StrDir = "./QF_BV/float/",% 182/209
- %StrDir = "./QF_BV/galois/", % 2 BUGS / 4 fich (unknown)
- %StrDir = "./QF_BV/gulwani-pldi08/",
- %StrDir = "./QF_BV/log-slicing/",
- %StrDir = "./QF_BV/mcm/",
- %StrDir = "./QF_BV/pipe/",
- %StrDir = "./QF_BV/pspace/",
- %StrDir = "./QF_BV/rubik/",
- %StrDir = "./QF_BV/RWS/",
- %StrDir = "./QF_BV/sage/",
- %StrDir = "./QF_BV/spear/",
- %StrDir = "./QF_BV/stp_samples/",
- %StrDir = "./QF_BV/tacas07/",
- %StrDir = "./QF_BV/uclid/",
- %StrDir = "./QF_BV/uclid_contrib_smtcomp09/",
- %StrDir = "./QF_BV/uum/",
- %StrDir = "./QF_BV/VS3/",
- %StrDir = "./QF_BV/wienand-cav2008/",
- %StrDir = "./QF_BV/asp/",
- %StrDir = "./QF_BV/bench_ab/",%OK
- %StrDir = "./QF_BV/bmc-bv/",
- %StrDir = "./QF_BV/bmc-bv-svcomp14/",
- %StrDir = "./QF_BV/brummayerbiere/",
- %StrDir = "./QF_BV/brummayerbiere2/",
- %StrDir = "./QF_BV/brummayerbiere3/",
- %StrDir = "./QF_BV/brummayerbiere4/",
- %StrDir = "./QF_BV/bruttomesso/", % plein de TO
- %StrDir = "./QF_BV/crafted/",
+ %StrDir = "./QF_BV/float/",% 183/209
+ %StrDir = "./QF_BV/galois/", % 4/4
+ %StrDir = "./QF_BV/gulwani-pldi08/",% 5/6
+ %StrDir = "./QF_BV/log-slicing/",% 208/208
+ %StrDir = "./QF_BV/mcm/",% 170/183, 12 CoreDump
+ %StrDir = "./QF_BV/pipe/",% 1/1
+ %StrDir = "./QF_BV/pspace/",% 23/86
+ %StrDir = "./QF_BV/rubik/", % 7/7
+ %StrDir = "./QF_BV/RWS/", % 19/20
+ %StrDir = "./QF_BV/sage/", % 123/26607 (15 coredump)
+ %StrDir = "./QF_BV/spear/", % 1325/1695
+ %StrDir = "./QF_BV/stp_samples/", % 43/426
+ %StrDir = "./QF_BV/tacas07/", % 4/5
+ %StrDir = "./QF_BV/uclid/", % 392/414
+ %StrDir = "./QF_BV/uclid_contrib_smtcomp09/", % 7/7
+ %StrDir = "./QF_BV/uum/", % 0/8
+ %StrDir = "./QF_BV/VS3/", % 11/11
+ %StrDir = "./QF_BV/wienand-cav2008/", % 5/18
+ %StrDir = "./QF_BV/asp/", % 388/391
+ %StrDir = "./QF_BV/bench_ab/",% 0/285
+ %StrDir = "./QF_BV/bmc-bv/", % 8/30 (2 coredump)
+ %StrDir = "./QF_BV/bmc-bv-svcomp14/", % 16/32
+ %StrDir = "./QF_BV/brummayerbiere/", % 44/52
+ %StrDir = "./QF_BV/brummayerbiere2/", % 38/65
+ %StrDir = "./QF_BV/brummayerbiere3/", % 79/79
+ %StrDir = "./QF_BV/brummayerbiere4/", % 0/10
+ %StrDir = "./QF_BV/bruttomesso/", % 975/976
+ %StrDir = "./QF_BV/crafted/", % 5/21
%-----------------------------------------------------------------------
- %StrDir = "./QF_AUFBVFP/20210301-Alive2/",% 0
- % devenu sat après correction d'un mauvais appel a smtlib_select !!!!
+ %StrDir = "./QF_AUFBVFP/20210301-Alive2/",% 1
%-----------------------------------------------------------------------
%StrDir = "QF_ABVFP/20170428-Liew-KLEE/imperial_svcomp_float-benchs_svcomp_mea8000.x86_64/", %0
%StrDir = "QF_ABVFP/20170428-Liew-KLEE/imperial_synthetic_non_terminating_klee_bug.x86_64/", % 0
%StrDir = "./QF_ABVFP/20170428-Liew-KLEE/aachen_real_gmp_gmp_klee_mul.x86_64/", % 3 (bitwuzla 0)
- %StrDir = "QF_ABVFP/20170428-Liew-KLEE/aachen_real_numerical_recipes_qrdcmp.x86_64/",
+ %StrDir = "QF_ABVFP/20170428-Liew-KLEE/aachen_real_numerical_recipes_qrdcmp.x86_64/", % 0
- %StrDir = "./QF_ABVFP/20170428-Liew-KLEE/", % 109 (177 unsupported) (cvc4 55)
+ %StrDir = "./QF_ABVFP/20170428-Liew-KLEE/", % 104/17933 (177 u, 101 I) (cvc4 55)
%StrDir = "./QF_ABVFP/20170501-Heizmann-UltimateAutomizer/", % 0 min_solve (cvc4 0) OK
%----------------------------------------------------------------------
%StrDir = "./QF_ABVFPLRA/20190429-UltimateAutomizerSvcomp2019/",% 0 (cvc4 1|2)!
@@ -901,7 +964,7 @@ smt_test(TO,Size,CI) :-
% (bitwuzla 1) (le passage en int casse les deltas)
%----------------------------------------------------------------
%StrDir = "./QF_BVFPLRA/20170501-Heizmann-UltimateAutomizer/", % 0 (cvc4 0)
- %StrDir = "./QF_BVFPLRA/20190429-UltimateAutomizerSvcomp2019/", % 8 + 11u (cvc4 17 + 11u sinon 0u avec --fp-exp?))
+ %StrDir = "./QF_BVFPLRA/20190429-UltimateAutomizerSvcomp2019/", % 9 + 11u (cvc4 17 + 11u sinon 0u avec --fp-exp?))
%StrDir = "./QF_BVFPLRA/2019-Gudemann/", % 0 (cvc4 1)
%----------------------------------------------------------------
%StrDir = "./QF_FPLRA/20170501-Heizmann-UltimateAutomizer/", % 0 (cvc4 0)
@@ -912,65 +975,89 @@ smt_test(TO,Size,CI) :-
%StrDir = "./QF_FP/20170501-Heizmann-UltimateAutomizer/", % 0
%StrDir = "./QF_FP/20190429-UltimateAutomizerSvcomp2019/",% 0 (bitwuzla 0)
%StrDir = "./QF_FP/ramalho/", % 0 (cvc4 19)(bitwuzla 17)
- %StrDir = "./QF_FP/griggio/", % 54 (min_solve, sans lin_solve ni ls_reduce..)(39)
+ %StrDir = "./QF_FP/griggio/", % 51 (min_solve, sans lin_solve ni ls_reduce..)(39)
%(cvc4 89)(bitwuzla 74) LES DD DEMARRENT TROP VITE ?
%StrDir = "./QF_FP/schanda/spark/", % 6! (min_solve avec X =< (X+Y)/2 =< Y) (ncvc4 8)(bitwuzla 3)
%StrDir = "./QF_FP/wintersteiger/", % tout OK
%-----------------------------------------------------------------------
%StrDir = "./QF_UFFP/schanda/",% 0
%-----------------------------------------------------------------
- %StrDir = "./QF_UF/", % 426 (pour 1061)
+ %StrDir = "./QF_UF/", % 278/822 (239 I)
%----------------------------------------------------------------
- %StrDir = "./QF_AUFBV/", %
+ %StrDir = "./QF_AUFBV/", % 9/34 (6 I)
%----------------------------------------------------------------
- %StrDir = "./QF_UFIDL/", % 290 (pour 329)
+ %StrDir = "./QF_UFIDL/", % 273/321 (8 I)
%----------------------------------------------------------------
- %StrDir = "./QF_UFLIA/", % 104 (pour 129)
+ %StrDir = "./QF_UFLIA/", % 99/129
%----------------------------------------------------------------
- %StrDir = "./QF_UFLRA/", % 141 (pour 384)
+ %StrDir = "./QF_UFLRA/", % 75/302 (82 I)
%----------------------------------------------------------------
- %StrDir = "./QF_ABV/bench_ab/",%1
- %StrDir = "./QF_ABV/bmc-arrays/",%10(9 core)
+ %StrDir = "./QF_ABV/2018-Mann/", % 1/1 (4 I)
+ %StrDir = "./QF_ABV/2019-Mann/", % too big
+ %StrDir = "./QF_ABV/2019-Wolf-fmbench/", % too big
+ %StrDir = "./QF_ABV/20200415-Yurichev/", % 1/1
+ %StrDir = "./QF_ABV/bench_ab/",% 0/117 (2 I)
+ %StrDir = "./QF_ABV/bmc-arrays/",% 11/20 (19 I)
+ %StrDir = "./QF_ABV/brummayerbiere/",% 215/286 (7 I)
+ %StrDir = "./QF_ABV/brummayerbiere2/", % 19/22
+ %StrDir = "./QF_ABV/brummayerbiere3/", % 0/9 (1 I)
+ %StrDir = "./QF_ABV/btfnt/", % 1/1
+ %StrDir = "./QF_ABV/calc2/", % 12/18 (18 I)
+ %StrDir = "./QF_ABV/dwp_formulas/",
+ %StrDir = "./QF_ABV/ecc/", % 24/41 (11 I)
+ %StrDir = "./QF_ABV/egt/", % 3/7687 (32 I)
+ %StrDir = "./QF_ABV/jager/", % too big
+ %StrDir = "./QF_ABV/klee-selected-smt2/", % 256/350 (245 I)
+ %StrDir = "./QF_ABV/pipe/", % 1/1
+ %StrDir = "./QF_ABV/platania/", % 42/133 (142 I)
+ %StrDir = "./QF_ABV/sharing-is-caring/", % 0/40
+ %StrDir = "./QF_ABV/stp/", % 0/3 (37 I)
+ %StrDir = "./QF_ABV/stp_samples/", % 39/52
%-----------------------------------------------------------------
- %StrDir = "QF_AX/",
+ %StrDir = "QF_AX/", % 8/551
%StrDir = "QF_AX/storeinv/", % 4
- %StrDir = "QF_AX/swap/", % 8 -> 15
+ %StrDir = "QF_AX/swap/", % 4
%StrDir = "QF_AX/storecomm/", % 0
%StrDir = "QF_AX/cvc/", % 0
- %StrDir = "QF_ALIA/qlock2/", % Des TO et core dump
- %StrDir = "QF_ALIA/cvc/", % 3
- %StrDir = "QF_ALIA/UltimateAutomizer2/",% des TO
- %StrDir = "QF_ALIA/piVC/", % 11
- %StrDir = "QF_ALIA/ios/", % 26
+ %StrDir = "QF_ALIA/", % 63/114 (1 I)
+ %StrDir = "QF_ALIA/qlock2/", % 45/52
+ %StrDir = "QF_ALIA/cvc/", % 4/5
+ %StrDir = "QF_ALIA/UltimateAutomizer/",% 4/8
+ %StrDir = "QF_ALIA/UltimateAutomizer2/",% 1/4 (1 I)
+ %StrDir = "QF_ALIA/piVC/", % 6/15
+ %StrDir = "QF_ALIA/ios/", % 0/30
- %StrDir = "QF_NIA/20170427-VeryMax/", Que des TO
- %StrDir = "QF_NIA/AProVE/",
- %StrDir = "QF_NIA/calypto/", %OK
- %StrDir = "QF_NIA/LassoRanker/",%OK mieux en real_int qu'en int !!
- %StrDir = "QF_NIA/LCTES/",%TO
- %StrDir = "QF_NIA/leipzig/",
- %StrDir = "QF_NIA/mcm/",%TO
- %StrDir = "QF_NIA/UltimateAutomizer/",%OK
- %StrDir = "QF_NIA/UltimateLassoRanker/",%TO
+ %StrDir = "QF_NIA/",
+ %StrDir = "QF_NIA/20170427-VeryMax/", %Que des TO
+ %StrDir = "QF_NIA/AProVE/", % 1475/2406 (3 I) 5 unknown
+ StrDir = "bugs_NIA/", % 6/6 unknown !!!
+ %StrDir = "QF_NIA/calypto/", % 6/117
+ %StrDir = "QF_NIA/LassoRanker/",% 52/106
+ %StrDir = "QF_NIA/LCTES/",% 2/2
+ %StrDir = "QF_NIA/leipzig/", % 126/167
+ %StrDir = "QF_NIA/mcm/",% 162/162 (24 I)
+ %StrDir = "QF_NIA/UltimateAutomizer/",% 0/7
+ %StrDir = "QF_NIA/UltimateLassoRanker/",% 0/4
- %StrDir = "QF_LIA/20180326-Bromberger/",
- %StrDir = "QF_LIA/cut_lemmas/", %TO
- %StrDir = "QF_LIA/wisa/", %TO
- %StrDir = "QF_LIA/arctic-matrix/", %TO
- %StrDir = "QF_LIA/check/", %OK + TO
- %StrDir = "QF_LIA/RTCL/", %OK
- %StrDir = "QF_LIA/miplib2003/", %TO
- %StrDir = "QF_LIA/rings_preprocessed/", %TO
- %StrDir = "QF_LIA/mathsat/", %TO
- %StrDir = "QF_LIA/CAV_2009_benchmarks/smt/", %TO
- %StrDir = "QF_LIA/rings/", %TO
- %StrDir = "QF_LIA/fft/", %TO
-
- %StrDir = "QF_ANIA/",% Unsupported ou TO
+ %StrDir = "QF_LIA/20180326-Bromberger/more_slacked/CAV_2009_benchmarks/coef-size/smt/size-10/", % 5/6
+ %StrDir = "QF_LIA/20180326-Bromberger/more_slacked/cut_lemmas/10-vars/",% 4/7
+ %StrDir = "QF_LIA/20180326-Bromberger/unbd-sage/unbd010v15c/",% 25/25
+ %StrDir = "QF_LIA/cut_lemmas/", % 90/93
+ %StrDir = "QF_LIA/wisa/", % 5/5
+ %StrDir = "QF_LIA/arctic-matrix/",% 5/5 (95 I)
+ %StrDir = "QF_LIA/check/", % 0/5
+ %StrDir = "QF_LIA/RTCL/", % 0/2
+ %StrDir = "QF_LIA/miplib2003/", % too big
+ %StrDir = "QF_LIA/rings_preprocessed/", % 288/294
+ %StrDir = "QF_LIA/mathsat/", % 51/91
+ %StrDir = "QF_LIA/CAV_2009_benchmarks/smt/", % 508/540
+ %StrDir = "QF_LIA/rings/", % 278/294
+ %StrDir = "QF_LIA/fft/", % 7/9
+
+ %StrDir = "QF_ANIA/",% 0/1 (7 I)
- %StrDir = "QF_ABV/bmc-arrays/",
- %StrDir = "QF_AFPBV/dwp_formulas/", %TRES DUR
+ %StrDir = "QF_ABV/bmc-arrays/", % 11/20 (19 I)
smt_test0(TO,Size,StrDir,CI).
:- lib(timeout).
@@ -987,18 +1074,30 @@ smt_test0(TO,Size,StrDir,CI) :-
(SubdirList0 == [] ->
SubdirList = ["."]
; SubdirList = SubdirList0),
+ MaxSize = 300000, % pour QF_FP/griggio
(foreach(Dir,SubdirList),
fromto([],IS,OS,SmtFileList),
- param(StrDir) do
+ fromto(0,ITB,OTB,TooBig),
+ fromto(0,IMS,OMS,MaxSizeSeen),
+ param(StrDir,MaxSize) do
append_strings(StrDir,Dir,SubDir),
os_file_name(SubDir,OS_SubDir),
read_directory(OS_SubDir, "*.smt2", _, SmtList),
(foreach(F,SmtList),
fromto(IS,I,O,OS),
- param(SubDir) do
+ fromto(ITB,IITB,OITB,OTB),
+ fromto(IMS,IIMS,OOMS,OMS),
+ param(SubDir,MaxSize) do
concat_string([SubDir,"/",F],PF),
os_file_name(PF,OS_PF),
- O = [OS_PF|I])),
+ get_file_info(OS_PF,size,FSize),
+ OOMS is max(IIMS,FSize),
+ (FSize > MaxSize ->
+ % Trop gros
+ OITB is IITB + 1,
+ O = I
+ ; OITB = IITB,
+ O = [OS_PF|I]))),
initNbCodes,
get_flag(version_as_list,[Ver|_]),
@@ -1090,6 +1189,12 @@ smt_test0(TO,Size,StrDir,CI) :-
; true),
getval(nbFile,NbFile),
writeln(output,"Files":NbFile),
+ (TooBig > 0 ->
+ write(output,"Ignored Too Big Files (> "),
+ write(output,MaxSize),
+ writeln(output,"k)":TooBig),
+ writeln(output,"MaxSizeSeen":MaxSizeSeen)
+ ; true),
getval(nb0,Nb0),
writeln(output,"Unsat":Nb0),
getval(nb1,Nb1),
@@ -1112,6 +1217,38 @@ smt_test0(TO,Size,StrDir,CI) :-
(foreach(B,Bugs) do
writeln(output,B))).
+/*
+set_colibri_tests_sat_status :-
+ StrDir = "colibri_tests/colibri/tests/sat/",
+ os_file_name(StrDir,OS_Examples),
+ read_directory(OS_Examples,"*.smt2", _, SmtList),
+ (foreach(F,SmtList),
+ fromto([],I,O,SmtFileList),
+ param(OS_Examples) do
+ concat_string([OS_Examples,"/",F],PF),
+ os_file_name(PF,OS_PF),
+ O = [OS_PF|I]),
+ ((member(F,SmtFileList),
+ concat_string(["cat set_sat.txt ",F," > /tmp/sat_unsat.txt; mv /tmp/sat_unsat.txt ",F],Com),
+ sh(Com),
+ fail);
+ true).
+set_colibri_tests_unsat_status :-
+ StrDir = "colibri_tests/colibri/tests/unsat/",
+ os_file_name(StrDir,OS_Examples),
+ read_directory(OS_Examples,"*.smt2", _, SmtList),
+ (foreach(F,SmtList),
+ fromto([],I,O,SmtFileList),
+ param(OS_Examples) do
+ concat_string([OS_Examples,"/",F],PF),
+ os_file_name(PF,OS_PF),
+ O = [OS_PF|I]),
+ ((member(F,SmtFileList),
+ concat_string(["cat set_unsat.txt ",F," > /tmp/sat_unsat.txt; mv /tmp/sat_unsat.txt ",F],Com),
+ sh(Com),
+ fail);
+ true).
+*/
repeatN :-
repeat,
getval(nb_try,Nb),
@@ -1131,6 +1268,8 @@ smt_unit_test(TO,CI) :-
% int!) des TOs sur
% newton en CI
%StrDir = "./colibri_tests/colibri/tests/unsat/", %0
+
+ %StrDir = "./QF_LIA_sat/20180326-Bromberger/",
%StrDir = "./QF_BVFP/20170428-Liew-KLEE/imperial_svcomp_float-benchs_svcomp_mea8000.x86_64/",
%StrDir = "./smtlib_schanda-master/random/", % tout OK ou unsupported
diff --git a/Src/COLIBRI/colibri.pl b/Src/COLIBRI/colibri.pl
index f54b06899590095e73d47ff7530981eeefca4127..03e9cbce57c64334489407d87acc64d72d8d66d4 100755
--- a/Src/COLIBRI/colibri.pl
+++ b/Src/COLIBRI/colibri.pl
@@ -1,13 +1,14 @@
-:- pragma(nowarnings).
% pour le debug
%:- pragma(debug).
% pour le debug des handlers
?- unlock(sepia_kernel,"Sepia").
?- unskipped(unify_attributes/2)@sepia_kernel.
+
% pour espionner unify_term_XX il faut un spy
% mais leap ne s'arrete pas la premiere fois il faut
% d'abord passer par un =/2 pour pouvoir s'arreter ensuite ?
-
+:- pragma(nowarnings).
+/*
%% Rend le compilateur silencieux
:- set_event_handler(139,true/0).
@@ -25,10 +26,11 @@
%% Warning "already reexported"
:- set_event_handler(90,true/0).
-
-
+*/
:- set_flag(variable_names,off).
+%:- set_flag(variable_names,check_singletons).
+
:- lib(timeout).
:- module(eclipse).
diff --git a/Src/COLIBRI/lib/v5/x86_64_linux/simplex_ocaml.so b/Src/COLIBRI/lib/v5/x86_64_linux/simplex_ocaml.so
index d52229e72fb6bd49bd9065911b84001fcbbcc355..199febcef83b14d12f4bf6384b6df8aea20883fc 100755
Binary files a/Src/COLIBRI/lib/v5/x86_64_linux/simplex_ocaml.so and b/Src/COLIBRI/lib/v5/x86_64_linux/simplex_ocaml.so differ
diff --git a/Src/COLIBRI/lib/v7/x86_64_linux/simplex_ocaml.so b/Src/COLIBRI/lib/v7/x86_64_linux/simplex_ocaml.so
index 87e8299312dad66d8d80645a20e7df522a37bed8..85e191499fa6afb6290fc9b1bfd6d5619290ffa3 100755
Binary files a/Src/COLIBRI/lib/v7/x86_64_linux/simplex_ocaml.so and b/Src/COLIBRI/lib/v7/x86_64_linux/simplex_ocaml.so differ
diff --git a/Src/COLIBRI/lin.pl b/Src/COLIBRI/lin.pl
index c54fd1989d37920fde4b0005fe4806af8718a988..88ce686a8b01d55fc858755edd7aee5bda16a707 100644
--- a/Src/COLIBRI/lin.pl
+++ b/Src/COLIBRI/lin.pl
@@ -50,7 +50,7 @@ unify_term_lin(Atom, _) :-
unify_term_lin(Y{AttrY}, AttrX) ?-
unify_lin_lin(Y, AttrX, AttrY).
-unify_lin_lin(Y, AttrX, AttrY) :-
+unify_lin_lin(_Y, AttrX, AttrY) :-
var(AttrY),!,
/*** VAR + META ***/
% Liaison a une variable non attribuee
@@ -98,16 +98,16 @@ add_lin_cstr(V{(Id,CC,L,H,Infos)},Cstr) ?- !,
add_lin_cstr(_,_).
:- export get_lin_cstrs/2.
-get_lin_cstrs(V{(_,_,_,_,Infos)},Cstrs) ?-
+get_lin_cstrs(_V{(_,_,_,_,Infos)},Cstrs) ?-
Cstrs = Infos.
:- export get_lin_var_id/2.
-get_lin_var_id(V{(Ident,_,_,_,_)},Id) ?-
+get_lin_var_id(_V{(Ident,_,_,_,_)},Id) ?-
Id = Ident.
:- export get_lin_var_cc/2.
-get_lin_var_cc(V{(_,CCV,_,_,_)},CC) ?-
+get_lin_var_cc(_V{(_,CCV,_,_,_)},CC) ?-
CC = CCV.
:- export get_lin_var_bounds/3.
-get_lin_var_bounds(V{(_,_,Low,High,_)},L,H) ?-
+get_lin_var_bounds(_V{(_,_,Low,High,_)},L,H) ?-
L = Low,
H = High.
diff --git a/Src/COLIBRI/lp_arith.pl b/Src/COLIBRI/lp_arith.pl
index a713d7e441d8320d1498236a8158eef62a181e20..55e6a38fad9eb1f356a303cb3cf6ea8976e9e46e 100755
--- a/Src/COLIBRI/lp_arith.pl
+++ b/Src/COLIBRI/lp_arith.pl
@@ -26,6 +26,7 @@ no_approx :-
protect_interrupts_and_gc(Goal) :-
set_flag(enable_interrupts,off),
set_flag(gc,off),
+ getval(lin_env,Env),
block((call(Goal) ->
set_flag(gc,on),
set_flag(enable_interrupts,on)
@@ -33,7 +34,8 @@ protect_interrupts_and_gc(Goal) :-
set_flag(enable_interrupts,on),
fail),
Tag,
- (set_flag(gc,on),
+ (setval(lin_env,Env),
+ set_flag(gc,on),
set_flag(enable_interrupts,on),
exit_block(Tag))).
@@ -225,9 +227,7 @@ new_ocaml_var(V) :-
getval(cpt_varId,Cpt),
concat_string(["v",Cpt],VS),
incval(cpt_varId),
- (fail,get_type(V,int) ->
- simplex_ocaml_var_int_create(VS,Id)
- ; simplex_ocaml_var_create(VS,Id)),
+ simplex_ocaml_var_create(VS,Id),
set_lin_var_id(V,Id).
reset_lin_vars_bounds([],_).
@@ -437,10 +437,7 @@ lin_solve1(Status) :-
get_type(Var,Type)),
getval(lin_env,OEnv),
(not ((foreach(NC,LCstrs) do
- (insert_lin_cstr(NC) ->
- true
- ; call(spy_here)@eclipse,
- insert_lin_cstr(NC))),
+ protected_insert_lin_cstr(NC)),
incr_N_steps(1),
silent_simplex_solve(IdTypes,Ass),
setval(lin_ass,Ass))
@@ -449,12 +446,11 @@ lin_solve1(Status) :-
getval(gdbg,1)@eclipse,
writeln(output,fail_full_lin_solve),
fail
-/*
; % Inhibe pour l'instant: pb etat persistant
setval(lin_env,OEnv),
Status = not_solved,
set_priority(Prio)).
-*/
+/*
; % recuperer un modele et le tester
% pour un Status "solved"
reset_touched_linvars,
@@ -468,7 +464,7 @@ lin_solve1(Status) :-
setval(lin_env,OEnv)
; try_lin_solution(Vars,Ass,Status)),
set_priority(Prio)).
-
+*/
lin_solve1(Status) :-
(var(Status) ->
% pas de variable lineaire on teste
@@ -520,7 +516,9 @@ silent_simplex_solve(IdTypes,Ass) :-
get_cst_from_OCamlRat(l,Type,Rat,L),
get_cst_from_OCamlRat(h,Type,Rat,H),
((Type == int,
- L > H)
+ (L > H;
+ abs(L) =:= 1.0Inf;
+ abs(H) =:= 1.0Inf))
->
% pas integral !
true
@@ -563,10 +561,10 @@ optimize_var_bound(Obj,LCstrs,Bound) :-
SR \== "Unsat",
arg(1,Obj,X),
get_type(X,Type),
- (foreach(C,LCstrs) do insert_lin_cstr(C)),
+ (foreach(C,LCstrs) do protected_insert_lin_cstr(C)),
silent_simplex(Obj,Type,Bound)).
/*
- not not ((foreach(C,LCstrs) do insert_lin_cstr(C)),
+ not not ((foreach(C,LCstrs) do protected_insert_lin_cstr(C)),
silent_simplex(Obj,Type,Bound),
setval(simplex_bound,Bound)),
getval(simplex_bound,Bound)).
@@ -712,14 +710,14 @@ try_lin_solution0(LVars,LSol,Status) :-
try_ground_solutions([],[],[],[],_).
try_ground_solutions([V|LV],[S|LS],NLV,NLS,Stop) :-
- (var(S) ->
- NLV = [V|ENLV],
- NLS = [S|ENLS],
- try_ground_solutions(LV,LS,ENLV,ENLS,Stop)
- ; call_priority(protected_unify(V,S),1),
+ (nonvar(S) ->
+ call_priority(protected_unify(V,S),1),
(current_suspension(_) ->
try_ground_solutions(LV,LS,NLV,NLS,Stop)
- ; Stop = 1)).
+ ; Stop = 1)
+ ; NLV = [V|ENLV],
+ NLS = [S|ENLS],
+ try_ground_solutions(LV,LS,ENLV,ENLS,Stop)).
try_remaining_solutions([],[]).
try_remaining_solutions([V|LV],[S|LS]) :-
@@ -875,9 +873,11 @@ wake_lin_solve :-
; setval(delayed_lin_solve,[])).
wake_lin_solve.
+%lin_solve_var2(X,Called) :- !.
lin_solve_var2(X,Called) :-
get_priority(Prio),
set_priority(1),
+ getval(lin_env,Env),
statistics(runtime,[T0,_]),
get_touched_linvars(TVars,Inst),
reset_touched_linvars,
@@ -928,7 +928,7 @@ lin_solve_var2(X,Called) :-
reset_lin_vars_bounds(Vars,Work),
%(LinCstrs \== [] -> call(spy_here)@eclipse; true),
(foreach(LC,LinCstrs) do
- insert_lin_cstr(LC)),
+ protected_insert_lin_cstr(LC)),
((var(Inst),
var(Work))
->
@@ -1052,7 +1052,7 @@ get_lin_sol_bounds(X) :-
reset_lin_vars_bounds(Vars,_),
get_lin_var_bounds(X,LX,HX),
(foreach(Cstr,LCstrs) do
- insert_lin_cstr(Cstr)),
+ protected_insert_lin_cstr(Cstr)),
silent_simplex(min(X),Type,MinX),
(MinX > LX ->
incval(simplex_steps)@eclipse,
@@ -1106,7 +1106,7 @@ lin_add_int(A,B,C) :-
same_lin_cc(Vars),
%remind_lin_cstr(add_int(A,B,C)),
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(add_int(A,B,C)),
+ protected_insert_lin_cstr(add_int(A,B,C)),
(foreach(VV,Vars),
param(A,B,C) do
add_lin_cstr(VV,add_int(A,B,C)))).
@@ -1162,7 +1162,7 @@ lin_add_real(Type,A,B,C) :-
same_lin_cc(Vars),
(Type == real ->
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(add_real(Type,A,B,C))
+ protected_insert_lin_cstr(add_real(Type,A,B,C))
; remind_lin_cstr(add_real(Type,A,B,C))),
(foreach(VV,Vars),
param(Type,A,B,C) do
@@ -1193,7 +1193,7 @@ lin_minus_real(Type,A,B,C) :-
same_lin_cc(Vars),
(Type == real ->
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(minus_real(Type,A,B,C))
+ protected_insert_lin_cstr(minus_real(Type,A,B,C))
; remind_lin_cstr(minus_real(Type,A,B,C))),
(foreach(VV,Vars),
param(Type,A,B,C) do
@@ -1222,7 +1222,7 @@ lin_op_int(A,B) :-
ls_define(B),
same_lin_cc(Vars),
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(add_int(A,B,0)),
+ protected_insert_lin_cstr(add_int(A,B,0)),
add_lin_cstr(A,op(A,B)),
add_lin_cstr(B,op(A,B))).
lin_op_int(A,B).
@@ -1253,7 +1253,7 @@ lin_mult_int(A,B,C) :-
nonvar(B))
->
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(mult_int(A,B,C))
+ protected_insert_lin_cstr(mult_int(A,B,C))
; remind_lin_cstr(mult_int(A,B,C))),
(foreach(VV,Vars),
param(A,B,C) do
@@ -1289,7 +1289,7 @@ lin_mult_real(Type,A,B,C) :-
is_real_box_rat(B,_)))
->
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(mult_real(Type,A,B,C))
+ protected_insert_lin_cstr(mult_real(Type,A,B,C))
; remind_lin_cstr(mult_real(Type,A,B,C))),
(foreach(VV,Vars),
param(Type,A,B,C) do
@@ -1320,7 +1320,7 @@ lin_div_real(Type,A,B,C) :-
is_real_box_rat(B,_)))
->
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(div_real(Type,A,B,C))
+ protected_insert_lin_cstr(div_real(Type,A,B,C))
; remind_lin_cstr(div_real(Type,A,B,C))),
(foreach(VV,Vars),
param(Type,A,B,C) do
@@ -1431,7 +1431,7 @@ lin_geq_int(A,B) :-
ls_define(B),
same_lin_cc(Vars),
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(geq_int(A,B)),
+ protected_insert_lin_cstr(geq_int(A,B)),
add_lin_cstr(A,geq_int(A,B)),
add_lin_cstr(B,geq_int(A,B))).
lin_geq_int(A,B).
@@ -1455,7 +1455,7 @@ lin_geq_real(A,B) :-
ls_define(B),
same_lin_cc(Vars),
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(geq_real(A,B)),
+ protected_insert_lin_cstr(geq_real(A,B)),
add_lin_cstr(A,geq_real(A,B)),
add_lin_cstr(B,geq_real(A,B))).
lin_geq_real(A,B).
@@ -1478,7 +1478,7 @@ lin_gt_int(A,B) :-
ls_define(B),
same_lin_cc(Vars),
remind_lin_cstr(vars(Vars)),
- insert_lin_cstr(gt_int(A,B)),
+ protected_insert_lin_cstr(gt_int(A,B)),
add_lin_cstr(A,gt_int(A,B)),
add_lin_cstr(B,gt_int(A,B))).
lin_gt_int(A,B).
@@ -1501,7 +1501,7 @@ lin_gt_real(A,B) :-
ls_define(A),
ls_define(B),
remind_lin_cstr(var(Vars)),
- insert_lin_cstr(gt_real(A,B)),
+ protected_insert_lin_cstr(gt_real(A,B)),
add_lin_cstr(A,gt_real(A,B)),
add_lin_cstr(B,gt_real(A,B))).
lin_gt_real(A,B).
@@ -1597,7 +1597,7 @@ lin_cast_float_to_double(F,D) ?-
add_lin_cstr(F,cast_float_to_double(F,D)),
add_lin_cstr(D,cast_float_to_double(F,D)),
(not_inf([F]) ->
- insert_lin_cstr(cast_float_to_double(F,D))
+ protected_insert_lin_cstr(cast_float_to_double(F,D))
; remind_lin_cstr(cast_float_to_double(F,D)))).
lin_cast_float_to_double(F,D).
@@ -1621,7 +1621,7 @@ lin_cast_int_real(Type,I,R) ?-
add_lin_cstr(R,cast_int_real(Type,I,R)),
% Tester si I est representable
(safe_integer_to_real(Type,I) ->
- insert_lin_cstr(cast_int_real(Type,I,R))
+ protected_insert_lin_cstr(cast_int_real(Type,I,R))
; remind_lin_cstr(cast_int_real(Type,I,R)))).
lin_cast_int_real(_,_,_).
@@ -1666,6 +1666,12 @@ is_lin_cstr0(cast_int_real(Type,I,R)) ?- !,
add_lin_vars_eq(I,R)
; true).
+protected_insert_lin_cstr(Cstr) :-
+ (insert_lin_cstr(Cstr) ->
+ true
+ ; % pas le droit d'échouer
+ true).
+
insert_lin_cstr(gt_int(A,B)) ?- !,
make_poly([(1,A),(-1,B),(-1,1)],Poly,Val),
assert_poly_geq_val(Poly,Val).
@@ -1703,7 +1709,7 @@ insert_lin_cstr(gt_real(A,B)) ?- !,
insert_lin_cstr(gt_int(A,B))
; % Pas correct si on utilise un epsilon
((is_real_box_rat(A,IRatA),
- denominator(IRatA,1),
+ protected_denominator(IRatA,1),
is_float_int_number(B))
->
% IRatA > B --> IRatA - 1 >= B
@@ -1711,7 +1717,7 @@ insert_lin_cstr(gt_real(A,B)) ?- !,
make_poly([(-1,B),(1,PIRatA)],PRA,VRA),
assert_poly_geq_val(PRA,VRA)
; ((is_real_box_rat(B,IRatB),
- denominator(IRatB,1),
+ protected_denominator(IRatB,1),
is_float_int_number(A))
->
% A > IRatB --> A >= IRatB + 1
@@ -1958,7 +1964,7 @@ insert_lin_cstr(add_real(Type,X,Y,XY)) ?- !,
XY =:= 0.0)
->
% oppose, idem entiers
- insert_lin_cstr(X+Y=0)
+ insert_lin_cstr(add_int(X,Y,0))
; (Type == real ->
% idem entiers
insert_lin_cstr(add_int(X,Y,XY))
@@ -2000,10 +2006,10 @@ insert_lin_cstr(minus_real(Type,X,Y,XY)) ?- !,
; true).
-
+% Problème à voir sut sat/bignum_lia2.smt2
insert_lin_cstr(mult_real(Type,X,Y,XY)) ?- !,
((once (var(X);var(Y)),
- (%Type == real;
+ (Type == real;
not_inf([X,Y,XY])))
->
(X == Y ->
@@ -2012,11 +2018,13 @@ insert_lin_cstr(mult_real(Type,X,Y,XY)) ?- !,
Cst = X;
is_real_box_rat(X,RatX),
Cst = RatX),
+ var(Y),
V = Y;
(nonvar(Y),
Cst = Y;
is_real_box_rat(Y,RatY),
Cst = RatY),
+ var(X),
V = X)
->
((Type == real;
@@ -2036,8 +2044,10 @@ insert_lin_cstr(mult_real(Type,X,Y,XY)) ?- !,
lin_real_approx(Type,XY,RXY))
; (getval(use_approx,1)@eclipse ->
(Type == real ->
- % idem entiers
- insert_lin_cstr(mult_int(X,Y,XY))
+ (not_inf([X,Y,XY]) ->
+ % idem entiers
+ insert_lin_cstr(mult_int(X,Y,XY))
+ ; true)
; dvar_range(Type,X,MinX,MaxX),
dvar_range(Type,Y,MinY,MaxY),
B1 is rational(MinX)*rational(MinY),
@@ -2111,7 +2121,7 @@ insert_lin_cstr(sqrt(XX,X)) ?- !,
insert_lin_cstr(div_real(Type,X,Y,XdY)) ?- !,
((not_zero(Y),
once (var(X),V=X;var(Y),V=Y),
- (%Type == real;
+ (Type == real;
not_inf([X,Y,XdY])))
->
((nonvar(Y);
@@ -2396,8 +2406,8 @@ get_OCamlRat_strings_from_cst(Float,SNum,SDen) :-
Rat = Float
; abs(Float) =\= 1.0Inf,
Rat is rational(Float)),
- numerator(Rat,Num),
- denominator(Rat,Den),
+ protected_numerator(Rat,Num),
+ protected_denominator(Rat,Den),
number_string(Num,SNum),
number_string(Den,SDen).
@@ -2409,11 +2419,13 @@ get_cst_from_OCamlRat(LHN,int,ORat,Int) ?- !,
simplex_ocaml_rat_num(ORat,SNum),
number_string(Int,SNum)
; get_cst_from_OCamlRat(LHN,float_double,ORat,Float),
- (LHN == l ->
- % minimisation
- Int is integer(ceiling(Float))
- ; % h (pas de n pour int)
- Int is integer(floor(Float)))).
+ (abs(Float) =:= 1.0Inf ->
+ Int = Float
+ ; (LHN == l ->
+ % minimisation
+ Int is integer(ceiling(Float))
+ ; % h (pas de n pour int)
+ Int is integer(floor(Float))))).
get_cst_from_OCamlRat(LHN,Type,ORat,Res) :-
simplex_ocaml_rat_num(ORat,SNum),
(SNum == "0" ->
@@ -2453,7 +2465,8 @@ ocaml_round(Rnd,Rnd).
float_of_OCamlRat(Type,Rnd,Rat,Float) :-
ocaml_round(Rnd,NRnd),
- float_of_OCamlRat0(Type,NRnd,Rat,Float).
+ float_of_OCamlRat0(Type,NRnd,Rat,Float0),
+ protected_unify(Float0,Float).
float_of_OCamlRat0(real,Mode,Rat,Float) ?- !,
diff --git a/Src/COLIBRI/mbv.pl b/Src/COLIBRI/mbv.pl
index 32a70dfdf0cf7c90f45b1da64cd53014b465061b..267e5a05d097e43801cd1a747e5569612c298709 100644
--- a/Src/COLIBRI/mbv.pl
+++ b/Src/COLIBRI/mbv.pl
@@ -119,7 +119,7 @@ copy_term_mbv(_{mbv:Dom}, Copy) ?-
;
true).
-print_mbv(_{mbv:bvdom(X1, X0, XLU, XGU)}, P) :-
+print_mbv(_{mbv:bvdom(X1, X0, _XLU, _XGU)}, P) :-
-?->
to_string_ish(X1, X0, P).
@@ -129,7 +129,7 @@ print_mbv(_{mbv:bvdom(X1, X0, XLU, XGU)}, P) :-
:- export redflag/1.
% Just to trace. redflag("BLAH") has no effect
-redflag(X).
+redflag(_X).
:- export gardefou/1.
/*
@@ -163,7 +163,7 @@ unify_dom_dom(_, AttrX, AttrY) :-
unify_dom_dom(X, AttrX, AttrY) :-
nonvar(AttrX),
- AttrX = bvdom(X1, X0, XLU, XGU),
+ AttrX = bvdom(_X1, _X0, XLU, XGU),
AttrY = bvdom(Y1, Y0, YLU, YGU),
CurrentLU is max(XLU,YLU),
CurrentGU is min(XGU,YGU),
@@ -239,7 +239,7 @@ nouveau domain = ancien domain â‹ Fix.
*/
:- export ui_to_bvdom/2.
ui_to_bvdom(X,bvbounds(M1,M0)) :-
- (get_attr_bv(X, bvdom(X1, X0, XLU, XGU)) ->
+ (get_attr_bv(X, bvdom(X1, X0, _XLU, _XGU)) ->
mfd:dvar_range(X, Min, Max),
MXM is xor(Min, Max),
Unknown is xor(X1, X0),
@@ -251,8 +251,8 @@ ui_to_bvdom(X,bvbounds(M1,M0)) :-
Enforce1 is MSK /\ Min,
M1 is X1 \/ Enforce1,
Enforce2 is (\ MSK) \/ Min,
- M0 is X0 /\ Enforce2,
- MLU is MSK * (- 1)
+ M0 is X0 /\ Enforce2
+%inutile ? MLU is MSK * (- 1)
; (M1,M0) = (X1,X0))
; redflag("IMPOSSIBLE, Filling a var with no BVDOM attr")).
@@ -386,7 +386,7 @@ bvdom_size(V, S) :-
Unknown is xor(X1, X0),
num_set_bits(Unknown, I),
S is 2 ^ I.
-bvdom_size(V, S). % Si pas une variable bv, choisir les entier:tester sur var(S)
+bvdom_size(_V,_S). % Si pas une variable bv, choisir les entier:tester sur var(S)
:- export get_bit_if_known/3.
get_bit_if_known(I,bvbounds( X1, X0),B) :-
@@ -413,7 +413,8 @@ get_bvbounds(C, D) :-
!,
D = bvbounds(C, C).
get_bvbounds(X, D) ?-
- get_attr_bv(X, bvdom(X1, X0, XLU, XGU)), D=bvbounds( X1, X0).
+ get_attr_bv(X, bvdom(X1, X0, _XLU, _XGU)),
+ D=bvbounds( X1, X0).
:- export get_attr_bv/2.
get_attr_bv((_{mbv:bvdom(X1, X0, XLU, XGU)}), AttrX) :-
@@ -634,28 +635,24 @@ shiftL_norm(bvbounds(Y1, Y0), Offset,
YY0 is (Y0 << Offset).
:- export shiftL_unk/4.
-shiftL_unk(M, bvbounds(Y1, Y0), Offset,
- bvbounds(YY1, YY0)) :-
+shiftL_unk(M, bvbounds(Y1, Y0), Offset, bvbounds(YY1, YY0)) :-
shiftedL_ones(Offset, ShOnes),
YY1 is (Y1 << Offset) /\ \ (-1 << M) ,
YY0 is ((Y0 << Offset) \/ ShOnes) /\ \ (-1 << M) .
:- export shiftL_unk/3. % Devra remplacer l'autre
-shiftL_unk(bvbounds(Y1, Y0), Offset,
- bvbounds(YY1, YY0)) :-
+shiftL_unk(bvbounds(Y1, Y0), Offset, bvbounds(YY1, YY0)) :-
shiftedL_ones(Offset, ShOnes),
YY1 is (Y1 << Offset),
YY0 is ((Y0 << Offset) \/ ShOnes).
:- export shiftR_norm/4.
-shiftR_norm(M, bvbounds(Y1, Y0), Offset,
- bvbounds(YY1, YY0)) :-
- YY1 is (Y1 >> Offset) ,%/\ \ (-1 << M) ,
- YY0 is (Y0 >> Offset) .%/\ \ (-1 << M).
+shiftR_norm(_M, bvbounds(Y1, Y0), Offset, bvbounds(YY1, YY0)) :-
+ YY1 is (Y1 >> Offset) ,% /\ \ (-1 << M) ,
+ YY0 is (Y0 >> Offset) .% /\ \ (-1 << M).
:- export shiftR_norm/3.
-shiftR_norm(bvbounds(Y1, Y0), Offset,
- bvbounds(YY1, YY0)) :-
+shiftR_norm(bvbounds(Y1, Y0), Offset, bvbounds(YY1, YY0)) :-
YY1 is (Y1 >> Offset),
YY0 is (Y0 >> Offset).
@@ -796,7 +793,7 @@ drill_heavy([B..T|Int], LHS, UHS, [B..T|NInt]) :-
T < LHS, % B.......T () () --> On y est pas encore
!,
drill_heavy(Int, LHS, UHS, NInt).
-drill_heavy([B..T|Int], LHS, UHS, [B..T|Int]) :-
+drill_heavy([B..T|Int], LHS, _UHS, [B..T|Int]) :-
(T == LHS; % B..(T) () --> Stop, there is already a hole there
B > LHS), % () () B..T | () (B)..T --> On a dépassé. LHS ∉ Interval
!.
diff --git a/Src/COLIBRI/mbv_propa.pl b/Src/COLIBRI/mbv_propa.pl
index 86ae21bd8856c5bcd35c4a6494960aa534163a00..112127292c6addcd7806d51334264a52d85d11f8 100644
--- a/Src/COLIBRI/mbv_propa.pl
+++ b/Src/COLIBRI/mbv_propa.pl
@@ -59,12 +59,13 @@ update_congr_interval_eq(X,Y):-
ui_to_bvdom(Y,DY),
fill_bvbounds(Y,DY).
-
% EN TEST: ca marche !!!
+
launch_bveq(Sx,X,Sy,Y) :-
!,
protected_unify(X,Y).
+
launch_bveq(S,X,S,Y) ?- !,
protected_unify(X,Y).
launch_bveq(Sx,X,Sy,Y) :-
@@ -833,9 +834,7 @@ bvsl_bis(M,X,Y,Z) :-
ui_to_bvdom(X,DX),
fill_bvbounds(X,DX),
ui_to_bvdom(Z,DZ),
- fill_bvbounds(Z,DZ),
- % 0 < Y < M, X =< Z
- launch_delta_leq(X,Z)
+ fill_bvbounds(Z,DZ)
; true),
sl_constr(M, X, Y, Z),
bvsl_inst_free(M,X,Y,Z,Continue1),
@@ -959,7 +958,9 @@ bvsr(M,X,Y,Z) :-
protected_unify(X,Z)
; (Y >= M ->
protected_unify(Z,0)
- ; bvsr_bis(M,X,Y,Z))).
+ ; B is 2^Y,
+ %div_mod(X,B,Z,_))).
+ bvsr_bis(M,X,Y,Z))).
/*
bvsr(M,X,Y,Z) :-
bulk_lazy_doms([X,Z],M),
diff --git a/Src/COLIBRI/mfd.pl b/Src/COLIBRI/mfd.pl
index a8b1786c2111c0c10493aae77a5727f8247190c1..5603d603027e5e02a2f2e4e769a5988c0a901c38 100755
--- a/Src/COLIBRI/mfd.pl
+++ b/Src/COLIBRI/mfd.pl
@@ -3,79 +3,79 @@
:- begin_module(mfd).
:- export
- unify_term_mfd/3, % pour le debug if faut spy + start_tracing a on
- dom_intersection/3,
- check_dom_intersection/2,
- %% idem precedent plus type en premier argument (bool,int,none)
- typed_check_dom_intersection/3,
- dom_union/3,
- dom_difference/3,
- list_to_dom/2,
- is_fd_domain/1,
- is_integer_domain/1,
- two_value_domain/2,
- set_intervals/2,
- quiet_set_intervals/2, % idem mais sans notify_constrained/wake
- get_intervals/2,
- dvar_domain/2,
- dvar_size/2,
- mindomain/2,
- maxdomain/2,
- dvar_range/3,
- dom_range/3,
- dvar_replace/2,
- dvar_set/2, %% dvar_replace + notify
- dvar_update/2, %% dvar_set + INTERSECTION
- dvar_remove_smaller/2,
- dvar_remove_greater/2,
- dvar_remove_smaller2/2, %% version sans notify
- dvar_remove_greater2/2, %% version sans notify
- dvar_remove_element/2,
- in_domain/2,
- in_interval/2,
- init_domain/2,
- copy_domain/2,
- %% Interface
- '::'/2,
- op(700,xfx,'::').
+ unify_term_mfd/3, % pour le debug if faut spy + start_tracing a on
+ dom_intersection/3,
+ check_dom_intersection/2,
+ % idem precedent plus type en premier argument (bool,int,none)
+ typed_check_dom_intersection/3,
+ dom_union/3,
+ dom_difference/3,
+ list_to_dom/2,
+ is_fd_domain/1,
+ is_integer_domain/1,
+ two_value_domain/2,
+ set_intervals/2,
+ quiet_set_intervals/2, % idem mais sans notify_constrained/wake
+ get_intervals/2,
+ dvar_domain/2,
+ dvar_size/2,
+ mindomain/2,
+ maxdomain/2,
+ dvar_range/3,
+ dom_range/3,
+ dvar_replace/2,
+ dvar_set/2, %% dvar_replace + notify
+ dvar_update/2, %% dvar_set + INTERSECTION
+ dvar_remove_smaller/2,
+ dvar_remove_greater/2,
+ dvar_remove_smaller2/2, %% version sans notify
+ dvar_remove_greater2/2, %% version sans notify
+ dvar_remove_element/2,
+ in_domain/2,
+ in_interval/2,
+ init_domain/2,
+ copy_domain/2,
+ % Interface
+ '::'/2,
+ op(700,xfx,'::').
:- import
- setarg/3,
- replace_attribute/3
- from sepia_kernel.
+ setarg/3,
+ replace_attribute/3
+ from sepia_kernel.
:- import
- my_notify_constrained/1,
- my_schedule_suspensions/2,
- check_constrained_var/2,
- check_constrained_vars/2,
- schedule_bound/2
- from notify.
+ my_notify_constrained/1,
+ my_schedule_suspensions/2,
+ check_constrained_var/2,
+ check_constrained_vars/2,
+ schedule_bound/2
+ from notify.
:- import
- appendOpenlist2list/3,
- sum_intervals_size/3,
- sum_intervals_size_congr/4,
- reduce_congr_bounds_interval_list/4,
- interval_bounds/3,
- interval_range/3,
- min_max_inter/3,
- interval_from_bounds/3,
- max_interval_list/2,
- number_in_interval/2,
- list_to_intervals/3,
- intervals_intersection/4,
- check_intervals_intersection/2,
- check_enum_intervals_intersection/2,
- check_one_is_contained/3,
- notify_touched_linvar/1,
- protected_unify/1,
- protected_unify/2
- from colibri.
+ appendOpenlist2list/3,
+ sum_intervals_size/3,
+ sum_intervals_size_congr/4,
+ reduce_congr_bounds_interval_list/4,
+ interval_bounds/3,
+ interval_range/3,
+ min_max_inter/3,
+ interval_from_bounds/3,
+ max_interval_list/2,
+ number_in_interval/2,
+ list_to_intervals/3,
+ intervals_intersection/4,
+ check_intervals_intersection/2,
+ check_enum_intervals_intersection/2,
+ check_one_is_contained/3,
+ notify_touched_linvar/1,
+ protected_unify/1,
+ protected_unify/2
+ from colibri.
:- import
- exists_congr/3
- from mod.
+ exists_congr/3
+ from mod.
%----------------------------------------------------------------
@@ -141,39 +141,46 @@ unify_mfd_mfd(_, AttrX, AttrY, _) :-
unify_mfd_mfd(Y, AttrX, AttrY, SuspX) :-
nonvar(AttrY),
dom_intersection(AttrX,AttrY,dom(IntXY0)),
+/*
+ call(getval(check_congr,(IR,IM)))@colibri,
((dom(IntXY0) \== AttrY,
- exists_congr(Y,R,M))
- ->
+ ((IR,IM) \== (0,1),
+ R = IR,
+ M = IM;
+ exists_congr(Y,R,M)))
+*/
+ (exists_congr(Y,R,M) -> % elle est peut être nouvelle
reduce_congr_bounds_interval_list(IntXY0,R,M,IntXY)
- ; IntXY = IntXY0),
+ ; IntXY = IntXY0),
+ IntXY \== [],
((IntXY = [Val],
atomic(Val))
->
% X est deja reduit, il faut instancier Y
- %% "unify_suspend" reveillera les listes de Y
+ % "unify_suspend" reveillera les listes de Y
protected_unify(Y,Val)
- ; arg(1,AttrY,IntY),
+ ; arg(1,AttrY,IntY),
(IntY \== IntXY ->
% Reduction pour Y
setarg(1,AttrY,IntXY),
% On reveille les "constrained" de Y
notify_touched_linvar(Y),
- my_notify_constrained(Y)
+ my_notify_constrained(Y)
; true),
((nonvar(SuspX),
arg(1,AttrX,IntX),
IntX \== IntXY)
->
% Reduction pour X
- %% On reveille les "constrained" de X
+ % On reveille les "constrained" de X
arg(2,SuspX,CSuspX),
my_schedule_suspensions(Y,CSuspX)
; true)),
% Deux variables attribuees dans mfd sont liees
- %% "bound" provoque "constrained" on doit donc
- %% considerer ces deux types de contraintes
- %% On reveille les contraintes "sleeping" de X et Y
- %% si elles partagent une autre variable
+ % "bound" provoque "constrained" on doit donc
+ % considerer ces deux types de contraintes
+ % On reveille les contraintes "sleeping" de X et Y
+ % si elles partagent une autre variable
schedule_bound(SuspX,Y).
@@ -194,7 +201,7 @@ test_unify_mfd(Term, Attr) :-
test_unify_term_mfd(Atom, dom(Inter)) :-
atomic(Atom),!, % The metaterm was instantiated, wake all
/*** NONVAR + META ***/
- in_interval(Inter,Atom).
+ in_interval(Inter,Atom).
test_unify_term_mfd(Y{mfd:AttrY}, AttrX) :-
-?->
test_unify_mfd_mfd(Y,AttrX, AttrY).
@@ -203,24 +210,24 @@ test_unify_mfd_mfd(_,_,AttrY) :-
var(AttrY).
test_unify_mfd_mfd(Y, dom(IntX), dom(IntY)) ?-
/*** META + META ***/
- get_interval_type(IntX,TX),
- get_interval_type(IntY,TY),
- (TX \== TY ->
- call(spy_here)@eclipse,
+ get_interval_type(IntX,TX),
+ get_interval_type(IntY,TY),
+ (TX \== TY ->
+ call(spy_here)@eclipse,
writeln(output,"Error: argument types are different in test_unify_mfd":(TX,TY)),
- exit_block(abort)
- ; true),
- ((IntX \== IntY,
- exists_congr(Y,R,M))
- ->
- %% On a deja fait test_unify_mod_mod
- %% donc la congruence intersection existe mais
- %% comment la calculer ici (il manque celle de X) ??
- call(getval(check_congr,(IR,IM)))@colibri,
- intervals_intersection(integer,IntX,IntY,IntXY),
- reduce_congr_bounds_interval_list(IntXY,IR,IM,NIntXY),
- NIntXY \== []
- ; check_dom_intersection(dom(IntX),dom(IntY))).
+ exit_block(abort)
+ ; true),
+ ((IntX \== IntY,
+ exists_congr(Y,_R,_M))
+ ->
+ % On a deja fait test_unify_mod_mod
+ % donc la congruence intersection existe mais
+ % comment la calculer ici (il manque celle de X) ??
+ call(getval(check_congr,(IR,IM)))@colibri,
+ intervals_intersection(integer,IntX,IntY,IntXY),
+ reduce_congr_bounds_interval_list(IntXY,IR,IM,NIntXY),
+ NIntXY \== []
+ ; check_dom_intersection(dom(IntX),dom(IntY))).
@@ -283,41 +290,41 @@ set_bounds_mfd(Var,Low,High) :-
%----------------------------------------------------------------
%%:- mode check_dom_intersection(+,+).
check_dom_intersection(dom(Inter1),dom(Inter2)) :-
- ((Inter1 = [Val1],
- atomic(Val1))
- ->
- in_interval_chk_size(Inter2,Val1)
- ; ((Inter2 = [Val2],
- atomic(Val2))
- ->
- in_interval_chk_size(Inter1,Val2)
- ; check_dom_intersection1(dom(Inter1),dom(Inter2)))).
+ ((Inter1 = [Val1],
+ atomic(Val1))
+ ->
+ in_interval_chk_size(Inter2,Val1)
+ ; ((Inter2 = [Val2],
+ atomic(Val2))
+ ->
+ in_interval_chk_size(Inter1,Val2)
+ ; check_dom_intersection1(dom(Inter1),dom(Inter2)))).
%% Idem + type
%%:- mode typed_check_dom_intersection(++,+,+).
typed_check_dom_intersection(Type,dom(Inter1),dom(Inter2)) :-
- ((Inter1 = [Val1],
- atomic(Val1))
- ->
- in_interval_chk_size(Inter2,Val1)
- ; ((Inter2 = [Val2],
- atomic(Val2))
- ->
- in_interval_chk_size(Inter1,Val2)
- ; check_dom_intersection1(Type,Inter1,Inter2))).
+ ((Inter1 = [Val1],
+ atomic(Val1))
+ ->
+ in_interval_chk_size(Inter2,Val1)
+ ; ((Inter2 = [Val2],
+ atomic(Val2))
+ ->
+ in_interval_chk_size(Inter1,Val2)
+ ; check_dom_intersection1(Type,Inter1,Inter2))).
%%:- mode in_interval_chk_size(++,++).
in_interval_chk_size([I],Val) :-
- atomic(I),!,
- I == Val.
+ atomic(I),!,
+ I == Val.
in_interval_chk_size(Inter,Val) :-
- in_interval(Inter,Val).
+ in_interval(Inter,Val).
% Inter1 et Inter2 contiennent plus d'une valeur
%%:- mode check_dom_intersection1(++,++).
check_dom_intersection1(dom(Inter1),dom(Inter2)) :-
- get_interval_type(Inter1,Type),
- check_dom_intersection1(Type,Inter1,Inter2).
+ get_interval_type(Inter1,Type),
+ check_dom_intersection1(Type,Inter1,Inter2).
%%:- mode check_dom_intersection1(++,++,++).
@@ -325,26 +332,26 @@ check_dom_intersection1(dom(Inter1),dom(Inter2)) :-
check_dom_intersection1(bool,_,_) :- !.
%% Cas entier/generique
check_dom_intersection1(integer,Inter1,Inter2) :- !,
- (check_one_is_contained(Inter1,Inter2,_) ->
- true
- ; check_intervals_intersection(Inter1,Inter2)).
+ (check_one_is_contained(Inter1,Inter2,_) ->
+ true
+ ; check_intervals_intersection(Inter1,Inter2)).
check_dom_intersection1(none,Inter1,Inter2) :- !,
- %% On ne traite que les type enumeres
- check_enum_intervals_intersection(Inter1,Inter2).
-check_dom_intersection1(Type,Inter1,Inter2) :-
- writeln(output,erreur_check_dom_intersection1(Type)),
- exit_block(abort).
+ % On ne traite que les type enumeres
+ check_enum_intervals_intersection(Inter1,Inter2).
+check_dom_intersection1(Type,_Inter1,_Inter2) :-
+ writeln(output,erreur_check_dom_intersection1(Type)),
+ exit_block(abort).
%%:- mode get_interval_type(++,-).
get_interval_type([I|LI],Type) :-
- (type_from_inter(I,LI,Type) ->
- true
- ; Type = none).
+ (type_from_inter(I,LI,Type) ->
+ true
+ ; Type = none).
%%:- mode type_from_inter(++,++,-).
type_from_inter(_.._,_,integer).
type_from_inter(I,_,integer) :-
- integer(I).
+ integer(I).
type_from_inter(f,[t],bool).
type_from_inter(t,[f],bool).
@@ -355,32 +362,32 @@ type_from_inter(t,[f],bool).
% On suppose que si l'intervalle est type l'atom est du meme type
%----------------------------------------------------------------
%%:- mode in_domain(++,++).
-in_domain(dom(LInter),Atom) :- -?->
- in_interval(LInter,Atom).
+in_domain(dom(LInter),Atom) ?-
+ in_interval(LInter,Atom).
%%:- mode in_interval(++,++).
%% Cas booleen
-in_interval([f,t],Atom) :- -?-> !.
+in_interval([f,t],_Atom) ?- !.
%% Cas entier
in_interval(LInter,Atom) :-
- integer(Atom),!,
- number_in_interval(LInter,Atom).
+ integer(Atom),!,
+ number_in_interval(LInter,Atom).
%% A priori pas appele si on n'a que des booleens et des entiers
in_interval(LInter,Atom) :-
- atom_in_interval(LInter,Atom).
+ atom_in_interval(LInter,Atom).
%%:- mode atom_in_interval(++,++).
atom_in_interval([Inter|LInter],Atom) :-
- (type_of(Inter,atom) ->
- atom_in_atoms_interval([Inter|LInter],Atom)
- ; atom_in_interval(LInter,Atom)).
+ (type_of(Inter,atom) ->
+ atom_in_atoms_interval([Inter|LInter],Atom)
+ ; atom_in_interval(LInter,Atom)).
%%:- mode atom_in_atoms_interval(++,++).
atom_in_atoms_interval([Inter|LInter],Atom) :-
- Atom @>= Inter,
- (Atom == Inter ->
- true
- ; atom_in_atoms_interval(LInter,Atom)).
+ Atom @>= Inter,
+ (Atom == Inter ->
+ true
+ ; atom_in_atoms_interval(LInter,Atom)).
%----------------------------------------------------------------
% dom_intersection
@@ -530,22 +537,22 @@ insert_integer_interval(L,H,[L2..H2|LI2],NLI2,PEnd,NPEnd) :-
%----------------------------------------------------------------
%%:- mode dom_difference(++,++,-).
dom_difference(dom(Inter1),dom(Inter2),dom(Diff)) :-
- intervals_difference(Inter1,Inter2,Diff),
- Diff \== [].
+ intervals_difference(Inter1,Inter2,Diff),
+ Diff \== [].
:- export intervals_difference/3.
intervals_difference(Inter,Inter,Diff) ?- !,
- Diff = [].
-intervals_difference([],Inter,Diff) ?- !,
- Diff = [].
+ Diff = [].
+intervals_difference([],_Inter,Diff) ?- !,
+ Diff = [].
intervals_difference(Inter,[],Diff) ?- !,
- Diff = Inter.
+ Diff = Inter.
intervals_difference(Inter1,Inter2,Diff) :-
- (Inter2 == [] ->
- Diff = Inter1
- ; (get_interval_type(Inter1,integer) ->
- integer_intervals_difference(Inter1,Inter2,Diff)
- ; enum_intervals_difference(Inter1,Inter2,Diff))).
+ (Inter2 == [] ->
+ Diff = Inter1
+ ; (get_interval_type(Inter1,integer) ->
+ integer_intervals_difference(Inter1,Inter2,Diff)
+ ; enum_intervals_difference(Inter1,Inter2,Diff))).
%%:- mode enum_intervals_difference(++,++,-).
@@ -779,45 +786,45 @@ set_intervals(V,LInter) :-
; true).
% set_intervals sans notify_constrained
-quiet_set_intervals(V{mfd:dom(OldLInter)},OldLInter) ?- !.
+quiet_set_intervals(_V{mfd:dom(OldLInter)},OldLInter) ?- !.
quiet_set_intervals(V{mfd:OldDom},LInter) ?- !,
- get_interval_type(LInter,Type),
- list_to_intervals(Type,LInter,NLInter),
- (compound(OldDom) ->
- dom_intersection(OldDom,dom(NLInter),dom(NInterval0)),
- ((dom(NInterval0) \== OldDom,
- exists_congr(V,R,M))
- ->
- reduce_congr_bounds_interval_list(NInterval0,R,M,NInterval)
- ; NInterval = NInterval0),
- NInterval \== [],
- (dom(NInterval) == OldDom ->
- true
- ; ((NInterval = [Val],
- atomic(Val))
- ->
- protected_unify(V,Val)
- ; replace_attribute(V,dom(NInterval),mfd)
+ get_interval_type(LInter,Type),
+ list_to_intervals(Type,LInter,NLInter),
+ (compound(OldDom) ->
+ dom_intersection(OldDom,dom(NLInter),dom(NInterval0)),
+ ((dom(NInterval0) \== OldDom,
+ exists_congr(V,R,M))
+ ->
+ reduce_congr_bounds_interval_list(NInterval0,R,M,NInterval)
+ ; NInterval = NInterval0),
+ NInterval \== [],
+ (dom(NInterval) == OldDom ->
+ true
+ ; ((NInterval = [Val],
+ atomic(Val))
+ ->
+ protected_unify(V,Val)
+ ; replace_attribute(V,dom(NInterval),mfd)
% ,
% notify_touched_linvar(V)
- ))
- ; init_var_domain(V,NLInter)).
+ ))
+ ; init_var_domain(V,NLInter)).
quiet_set_intervals(V,LInter) :-
- LInter \== [],
- get_interval_type(LInter,Type),
- list_to_intervals(Type,LInter,NLInter),
- init_var_domain(V,NLInter).
+ LInter \== [],
+ get_interval_type(LInter,Type),
+ list_to_intervals(Type,LInter,NLInter),
+ init_var_domain(V,NLInter).
%%:- mode init_domain(?,+).
init_domain(V,dom(LInter)) :-
- check_constrained_var(V,Constrained),
- set_var_domain(V,LInter,Wake),
- ((nonvar(Constrained),
- nonvar(Wake))
- ->
- wake
- ; true).
+ check_constrained_var(V,Constrained),
+ set_var_domain(V,LInter,Wake),
+ ((nonvar(Constrained),
+ nonvar(Wake))
+ ->
+ wake
+ ; true).
%----------------------------------------------------------------
% dvar_domain(Var,Dom)
@@ -838,14 +845,14 @@ copy_domain(V1,V2) :-
%----------------------------------------------------------------
%% !!!!!!!!!!!! FAUX EN PRESENCE DE CONGRUENCES
dvar_size(Var,Size) :-
- dvar_domain(Var,dom(Intervals)),
- (get_interval_type(Intervals,integer) ->
- % defini dans util.pl
- (exists_congr(Var,_,Mod) ->
- sum_intervals_size_congr(Intervals,0,Mod,Size)
- ; sum_intervals_size(Intervals,0,Size))
- ; %% Type enumere
- length(Intervals,Size)).
+ dvar_domain(Var,dom(Intervals)),
+ (get_interval_type(Intervals,integer) ->
+ % defini dans util.pl
+ (exists_congr(Var,_,Mod) ->
+ sum_intervals_size_congr(Intervals,0,Mod,Size)
+ ; sum_intervals_size(Intervals,0,Size))
+ ; % Type enumere
+ length(Intervals,Size)).
@@ -905,29 +912,24 @@ dvar_replace(Int,dom(Inter)) :-
%% deja attribuees. Pas de my_notify_constrained
%%:- mode set_dom(?,++).
:- export set_dom/2.
-set_dom(Var{mfd:dom(Inter)},Inter) ?- !.
+set_dom(_Var{mfd:dom(Inter)},Inter) ?- !.
set_dom(Var{mfd:Dom},Inter0) ?-
- nonvar(Dom),
- !,
- (exists_congr(Var,R,M) ->
- reduce_congr_bounds_interval_list(Inter0,R,M,Inter)
- ; Inter = Inter0),
- Inter \== [],
- Dom = dom(OInter),
- (OInter == Inter ->
- true
- ; notify_touched_linvar(Var)),
- ((Inter = [Val],
+ nonvar(Dom),
+ !,
+ (exists_congr(Var,R,M) ->
+ reduce_congr_bounds_interval_list(Inter0,R,M,Inter)
+ ; Inter = Inter0),
+ Inter \== [],
+ Dom = dom(OInter),
+ (OInter == Inter ->
+ true
+ ; notify_touched_linvar(Var)),
+ ((Inter = [Val],
integer(Val))
->
protected_unify(Var = Val)
; setarg(1,Dom,Inter)).
-set_dom(Int,Inter).
-/*
-set_dom(Int,Inter) :-
- atomic(Int),
- in_interval(Inter,Int).
-*/
+set_dom(_Int,_Inter).
%----------------------------------------------------------------
% dvar_set(Var,+Dom)
@@ -937,21 +939,21 @@ set_dom(Int,Inter) :-
%----------------------------------------------------------------
%%:- mode dvar_set(?,+).
dvar_set(_{mfd:dom(Inter)},dom(Inter)) ?- !.
-dvar_set(Var{mfd:dom(OldInter)},dom(Inter)) ?- !,
- Inter \== [],
- ((Inter = [Val1],
- atomic(Val1))
- ->
- protected_unify(Val1 = Var)
- ; check_constrained_var(Var,Constrained),
- set_dom(Var,Inter),
- my_notify_constrained(Var),
- (var(Constrained) ->
- true
- ; wake)).
+dvar_set(Var{mfd:dom(_OldInter)},dom(Inter)) ?- !,
+ Inter \== [],
+ ((Inter = [Val1],
+ atomic(Val1))
+ ->
+ protected_unify(Val1 = Var)
+ ; check_constrained_var(Var,Constrained),
+ set_dom(Var,Inter),
+ my_notify_constrained(Var),
+ (var(Constrained) ->
+ true
+ ; wake)).
dvar_set(Int,dom(Inter)) :-
- atomic(Int),
- in_interval(Inter,Int).
+ atomic(Int),
+ in_interval(Inter,Int).
%----------------------------------------------------------------
% dvar_update(Var,+Dom)
@@ -959,42 +961,42 @@ dvar_set(Int,dom(Inter)) :-
%----------------------------------------------------------------
%%:- mode dvar_update(?,+).
dvar_update(_{mfd:dom(Inter)},dom(Inter)) ?- !.
-dvar_update(Var{mfd:dom(OldInter)},dom(Inter)) ?- !,
- Inter \== [],
- ((Inter = [Val1],
- atomic(Val1))
- ->
- protected_unify(Val1,Var)
- ; check_constrained_var(Var,Constrained),
- set_var_domain(Var,Inter,Wake),
- ((nonvar(Constrained),
- nonvar(Wake))
- ->
- my_notify_constrained(Var),
- wake
- ; true)).
+dvar_update(Var{mfd:dom(_OldInter)},dom(Inter)) ?- !,
+ Inter \== [],
+ ((Inter = [Val1],
+ atomic(Val1))
+ ->
+ protected_unify(Val1,Var)
+ ; check_constrained_var(Var,Constrained),
+ set_var_domain(Var,Inter,Wake),
+ ((nonvar(Constrained),
+ nonvar(Wake))
+ ->
+ my_notify_constrained(Var),
+ wake
+ ; true)).
dvar_update(Int,dom(Inter)) :-
- atomic(Int),
- in_interval(Inter,Int).
+ atomic(Int),
+ in_interval(Inter,Int).
%% Variante ou dom(Inter) est deja l'intersection
update_and_notify(_{mfd:dom(Inter)},dom(Inter)) :- -?-> !.
-update_and_notify(Var{mfd:dom(OldInter)},dom(Inter)) :- -?-> !,
- Inter \== [],
- ((Inter = [Val1],
- atomic(Val1))
- ->
- protected_unify(Val1,Var)
- ; check_constrained_var(Var,Constrained),
- set_dom(Var,Inter),
- my_notify_constrained(Var),
- (var(Constrained) ->
- true
- ; %% my_notify_constrained(Var),
- wake)).
+update_and_notify(Var{mfd:dom(_OldInter)},dom(Inter)) :- -?-> !,
+ Inter \== [],
+ ((Inter = [Val1],
+ atomic(Val1))
+ ->
+ protected_unify(Val1,Var)
+ ; check_constrained_var(Var,Constrained),
+ set_dom(Var,Inter),
+ my_notify_constrained(Var),
+ (var(Constrained) ->
+ true
+ ; % my_notify_constrained(Var),
+ wake)).
update_and_notify(Int,dom(Inter)) :-
- atomic(Int),
- in_interval(Inter,Int).
+ atomic(Int),
+ in_interval(Inter,Int).
%----------------------------------------------------------------
% dvar_remove_smaller(Var,+Elt)
diff --git a/Src/COLIBRI/mod.pl b/Src/COLIBRI/mod.pl
index 328a10d3af5a6a419be6b4253bc9e336c336ae1a..3bff7375891354767cde65c2143ab78e772f25e3 100755
--- a/Src/COLIBRI/mod.pl
+++ b/Src/COLIBRI/mod.pl
@@ -65,9 +65,13 @@ unify_mod(Term, Attr) :-
% We wake every time a variable is touched.
:- mode unify_term_mod(?, +).
unify_term_mod(I, congr(Rest,Mod)) :-
- integer(I),!, % The metaterm was instantiated, wake all
+ number(I),!, % The metaterm was instantiated, wake all
/*** NONVAR + META ***/
- Rest is I mod Mod.
+ (integer(I) ->
+ Rest is I mod Mod
+ ; abs(I) =\= 1.0Inf,
+ float(fix(I)) =:= I,
+ Rest is integer(I) mod Mod).
unify_term_mod(Y{AttrY}, AttrX) ?-
unify_mod_mod(Y, AttrX, AttrY).
@@ -75,16 +79,18 @@ unify_term_mod(Y{AttrY}, AttrX) ?-
unify_mod_mod(_, AttrX, AttrY) :-
var(AttrY), % No attribute for this extension
/*** VAR + META ***/
+ %call(setval(check_congr,(0,1)))@colibri,
AttrX = AttrY. % Keep both lists, do not wake
-unify_mod_mod(Y, AttrX, AttrY) :-
+unify_mod_mod(_Y, AttrX, AttrY) :-
nonvar(AttrY),
- congr_intersection(AttrX,AttrY,congr(RestXY,ModXY)),
- setarg(1,AttrY,RestXY),
- setarg(2,AttrY,ModXY).
+ congr_intersection(AttrX,AttrY,congr(RestXY,ModXY)),
+ setarg(1,AttrY,RestXY),
+ setarg(2,AttrY,ModXY).
+ %call(setval(check_congr,(RestXY,ModXY)))@colibri.
congr_intersection(congr(RX,MX),congr(RY,MY),congr(RXY,MXY)) :-
- inter_congr(RX,RY,MX,MY,RXY,MXY).
+ inter_congr(RX,RY,MX,MY,RXY,MXY).
%----------------------------------------------------------------
% test_unify
@@ -94,31 +100,35 @@ congr_intersection(congr(RX,MX),congr(RY,MY),congr(RXY,MXY)) :-
test_unify_mod(_, Attr) :-
/*** ANY + VAR ***/
var(Attr),
- %% On memorise l'intersection pour test_unify_mfd_mfd
- call(setval(check_congr,(0,1)))@colibri.
+ % On memorise l'intersection pour test_unify_mfd_mfd
+ call(setval(check_congr,(0,1)))@colibri.
test_unify_mod(Term, Attr) :-
compound(Attr),
test_unify_term_mod(Term, Attr).
% We wake every time a variable is touched.
:- mode test_unify_term_mod(?, +).
test_unify_term_mod(I, congr(R,M)) :-
- integer(I),!,
+ number(I),!,
/*** NONVAR + META ***/
- R is I mod M.
+ (integer(I) ->
+ R is I mod M
+ ; abs(I) =\= 1.0Inf,
+ float(fix(I)) =:= I,
+ R is integer(I) mod M).
test_unify_term_mod(_{mod:AttrY}, AttrX) :-
-?->
test_unify_mod_mod(AttrX, AttrY).
test_unify_mod_mod(_, AttrY) :-
var(AttrY),
- %% On memorise l'intersection pour test_unify_mfd_mfd
- call(setval(check_congr,(0,1)))@colibri.
+ % On memorise l'intersection pour test_unify_mfd_mfd
+ call(setval(check_congr,(0,1)))@colibri.
test_unify_mod_mod(congr(RX,MX), congr(RY,MY)) :-
-?->
/*** META + META ***/
- inter_congr(RX,RY,MX,MY,IR,IM),
- %% On memorise l'intersection pour test_unify_mfd_mfd
- call(setval(check_congr,(IR,IM)))@colibri.
+ inter_congr(RX,RY,MX,MY,IR,IM),
+ % On memorise l'intersection pour test_unify_mfd_mfd
+ call(setval(check_congr,(IR,IM)))@colibri.
%----------------------------------------------------------------
% copy_term
@@ -142,27 +152,45 @@ print_mod(_{mod:congr(R,M)}, Attribute) :-
+:- import
+ protected_unify/2,
+ protected_integer/2,
+ get_type/2,
+ launch_box_rat/2 from colibri.
-exists_congr(Var{mod:Congr},C,Mod) :- -?->
- compound(Congr),
- Congr = congr(C,Mod).
+exists_congr(Num,C,Mod) :-
+ number(Num),
+ !,
+ get_congr(Num,C,Mod).
+exists_congr(_Var{mod:Congr},C,Mod) ?-
+ compound(Congr),
+ Congr = congr(C,Mod).
get_congr(Var,C,Mod) :-
- var(Var),!,
- (exists_congr(Var,C,Mod) ->
- true
- ; C = 0,
- Mod = 1).
-get_congr(Const,Const,0).
-
+ var(Var),!,
+ (exists_congr(Var,C,Mod) ->
+ true
+ ; C = 0,
+ Mod = 1).
+get_congr(Const,NConst,0) :-
+ (integer(Const) ->
+ NConst = Const
+ ; protected_integer(Const,NConst)).
%%:- mode set_congr(?,++,++).
+set_congr(Var,C,0) ?- !,
+ % unification selon type
+ (get_type(Var,int) ->
+ protected_unify(Var,C)
+ ; % real (real_int)
+ RC is rational(C),
+ launch_box_rat(Var,RC)).
set_congr(Var{mod:Congr},C,Mod) ?-
- compound(Congr),!,
- setarg(1,Congr,C),
- setarg(2,Congr,Mod).
+ compound(Congr),!,
+ setarg(1,Congr,C),
+ setarg(2,Congr,Mod).
set_congr(Var,C,Mod) :-
- add_attribute(Var,congr(C,Mod),mod).
+ add_attribute(Var,congr(C,Mod),mod).
%%:- mode inter_congr(++,++,++,++,-,-).
diff --git a/Src/COLIBRI/mod_arith.pl b/Src/COLIBRI/mod_arith.pl
index e1044d828fd6c54a2076976bd6ccb8237fadc263..bd0fd77d85710d30211498f2fc6a72ddf3c9d892 100755
--- a/Src/COLIBRI/mod_arith.pl
+++ b/Src/COLIBRI/mod_arith.pl
@@ -251,77 +251,77 @@ clean_same_value_vars([V|LV],Inter,C,M,Seen,NewLV) :-
%% Version signée
addNs(N,A,B,C,UO) :-
- N >= 1,
- mfd:set_intervals(UO,[-1..1]),
- addNsu(s,N,A,B,C,UO).
+ N >= 1,
+ mfd:set_intervals(UO,[-1..1]),
+ addNsu(s,N,A,B,C,UO).
%% Version non signée
addNu(N,A,B,C,UO) :-
- N >= 1,
- %% Pas de débordement négatif
- mfd:set_intervals(UO,[0,1]),
- addNsu(u,N,A,B,C,UO).
+ N >= 1,
+ % Pas de débordement négatif
+ mfd:set_intervals(UO,[0,1]),
+ addNsu(u,N,A,B,C,UO).
addNsu(SU,N,A,A,C,UO) ?- !,
- multNsu(SU,N,2,A,C,UO).
+ multNsu(SU,N,2,A,C,UO).
addNsu(SU,N,A,B,C,UO) :-
intN_min_max(SU,N,Min,Max),
- mfd:set_intervals(A,[Min..Max]),
- mfd:set_intervals(B,[Min..Max]),
- mfd:set_intervals(C,[Min..Max]),
- Size is 1+Max-Min,
- %% A+B = C + K*Size et UO = K
- %% Garder cet ordre de propagation
- %% pour que les domaines soient correctement dimensionnés
- ((get_congr(C,CC,MC),
- (CC,MC) \== (0,1))
- ->
- %% On peut initaliser la congruence de Res
- %% Res = C + K*Size
- congr_add(CC,MC,0,Size,CRes,MRes),
- mfd:dvar_range(A,MinA,MaxA),
- mfd:dvar_range(B,MinB,MaxB),
- add_intervals(MinA..MaxA,MinB..MaxB,MinRes,MaxRes),
- interval_from_bounds(MinRes,MaxRes,IRes),
- mfd:set_intervals(Res,[IRes]),
- launch_congr(Res,CRes,MRes)
- ; true),
- add(A,B,Res),
- mfd:dvar_range(Res,LRes,HRes),
- (Min =< LRes ->
- %% Pas de débordement négatif
- (LRes > Max ->
- %% Débordement positif
- UO = 1
- ; mfd:dvar_remove_smaller(UO,0))
- ; true),
- (HRes =< Max ->
- %% Pas de débordement positif
- (HRes < Min ->
- %% Débordement négatif
- UO = -1
- ; mfd:dvar_remove_greater(UO,0))
- ; true),
- (UO == 0 ->
- %% Pas de débordement
- C = Res
- ; (SU == u ->
- %% On peut utiliser div_mod (en fait div_rem)
- div_mod(Res,Size,UO,C)
- ; %% SU = s, cas signé
- (C == 0 ->
- mult(Size,UO,Res)
- ; mult(Size,UO,KSize),
- add(C,KSize,Res))),
- check_addN(SU,N,A,B,Res,C,UO)).
+ mfd:set_intervals(A,[Min..Max]),
+ mfd:set_intervals(B,[Min..Max]),
+ mfd:set_intervals(C,[Min..Max]),
+ Size is 1+Max-Min,
+ % A+B = C + K*Size et UO = K
+ % Garder cet ordre de propagation
+ % pour que les domaines soient correctement dimensionnés
+ ((get_congr(C,CC,MC),
+ (CC,MC) \== (0,1))
+ ->
+ % On peut initaliser la congruence de Res
+ % Res = C + K*Size
+ congr_add(CC,MC,0,Size,CRes,MRes),
+ mfd:dvar_range(A,MinA,MaxA),
+ mfd:dvar_range(B,MinB,MaxB),
+ add_intervals(MinA..MaxA,MinB..MaxB,MinRes,MaxRes),
+ interval_from_bounds(MinRes,MaxRes,IRes),
+ mfd:set_intervals(Res,[IRes]),
+ launch_congr(Res,CRes,MRes)
+ ; true),
+ add(A,B,Res),
+ mfd:dvar_range(Res,LRes,HRes),
+ (Min =< LRes ->
+ % Pas de débordement négatif
+ (LRes > Max ->
+ % Débordement positif
+ UO = 1
+ ; mfd:dvar_remove_smaller(UO,0))
+ ; true),
+ (HRes =< Max ->
+ % Pas de débordement positif
+ (HRes < Min ->
+ % Débordement négatif
+ UO = -1
+ ; mfd:dvar_remove_greater(UO,0))
+ ; true),
+ (UO == 0 ->
+ % Pas de débordement
+ C = Res
+ ; (SU == u ->
+ % On peut utiliser div_mod (en fait div_rem)
+ div_mod(Res,Size,UO,C)
+ ; % SU = s, cas signé
+ (C == 0 ->
+ mult(Size,UO,Res)
+ ; mult(Size,UO,KSize),
+ add(C,KSize,Res))),
+ check_addN(SU,N,A,B,Res,C,UO)).
intN_min_max(s,N,Min,Max) :-
- DeuxPNm1 is 2^(N-1),
- Min is -DeuxPNm1,
- Max is DeuxPNm1 - 1.
+ DeuxPNm1 is 2^(N-1),
+ Min is -DeuxPNm1,
+ Max is DeuxPNm1 - 1.
intN_min_max(u,N,0,Max) :-
- Max is 2^N - 1.
+ Max is 2^N - 1.
%% Les cas A+B = A et A+B = B sont
@@ -329,61 +329,70 @@ intN_min_max(u,N,0,Max) :-
%% Pour le cas A+B = 0, l'arithmétique normale
%% réduit UO dans [-1,0]
check_addN(SU,N,A,B,ApB,C,UO) :-
- number(UO),
+ % number(UO),
+ ground((A,B,ApB,C,UO)),
!.
check_addN(SU,N,A,A,ApA,C,UO) ?- !,
- (var(A) ->
- %% L'arithmétique normale a transformé A+A en 2*A
- check_multN(SU,N,2,A,ApA,C,UO,UO)
- ; true).
+ (var(A) ->
+ % L'arithmétique normale a transformé A+A en 2*A
+ check_multN(SU,N,2,A,ApA,C,UO,UO)
+ ; true).
check_addN(SU,N,A,B,ApB,C,UO) :-
- ((term_variables([A,B,C],L),
- L \= [_,_|_])
- ->
- %% Au moins deux arguments sont instanciés
- true
- ; get_priority(Prio),
- set_priority(1),
- save_cstr_suspensions((A,B,C)),
+/*
+ ((term_variables([A,B,C],L),
+ L \= [_,_|_])
+ ->
+*/
+ (ground((A,B,ApB,C,UO)) ->
+ % Au moins deux arguments sont instanciés
+ true
+ ; get_priority(Prio),
+ set_priority(1),
+ save_cstr_suspensions((A,B,C)),
check_assoc_distN(check_addN,SU,N,A,B,C),
- intN_min_max(SU,N,Min,Max),
- mfd:dvar_range(ApB,LApB,HApB),
- (Min =< LApB ->
- %% Pas de débordement négatif
- (LApB > Max ->
- %% Débordement positif
- UO = 1
- ; mfd:dvar_remove_smaller(UO,0))
- ; true),
- (HApB =< Max ->
- %% Pas de débordement positif
- (HApB < Min ->
- %% Débordement négatif
- UO = -1
- ; mfd:dvar_remove_greater(UO,0))
- ; true),
- %% On peut exploiter les deltas pour réduire UO
- %% les réductions d'intervalles seront gérées par
- %% les contraintes arithmétiques normales
- check_addN_overflow(Min,Max,A,B,C,UO),
- ((UO == 0;
- term_variables([A,B,C],L1),
- L1 \= [_,_|_])
- ->
- true
- ; %% Factorisation:
- %% les 3 projections de addN sont des fonctions
- %% donc si 2 arguments sur A,B,C sont identiques
- %% à ceux d'un autre addN alors on peut unifier
- %% les troisièmes et unifier les UO
- factorize_addNsu_kill_ineqs(SU,N,A,B,C,UO,Continue1),
- (nonvar(Continue1) ->
-% SPrio = 3,
- SPrio = 4,
- my_suspend(check_addN(SU,N,A,B,ApB,C,UO),SPrio,(A,B,C,ApB,UO)->suspend:constrained)
- ; true)),
- set_priority(Prio),
- wake_if_other_scheduled(Prio)).
+ intN_min_max(SU,N,Min,Max),
+ mfd:dvar_range(ApB,LApB,HApB),
+ (Min =< LApB ->
+ % Pas de débordement négatif
+ (LApB > Max ->
+ % Débordement positif
+ UO = 1
+ ; mfd:dvar_remove_smaller(UO,0))
+ ; true),
+ (HApB =< Max ->
+ % Pas de débordement positif
+ (HApB < Min ->
+ % Débordement négatif
+ UO = -1
+ ; mfd:dvar_remove_greater(UO,0))
+ ; true),
+ % On peut exploiter les deltas pour réduire UO
+ % les réductions d'intervalles seront gérées par
+ % les contraintes arithmétiques normales
+ check_addN_overflow(Min,Max,A,B,C,UO),
+ (ground((A,B,ApB,C,UO)) ->
+/*
+ ((UO == 0;
+ term_variables([A,B,C],L1),
+ L1 \= [_,_|_])
+ ->
+*/
+ true
+ ; % Factorisation:
+ % les 3 projections de addN sont des fonctions
+ % donc si 2 arguments sur A,B,C sont identiques
+ % à ceux d'un autre addN alors on peut unifier
+ % les troisièmes et unifier les UO
+ factorize_addNsu_kill_ineqs(SU,N,A,B,C,UO,Continue1),
+ ((nonvar(Continue1);
+ nonground((A,B,ApB,C,UO)))
+ ->
+ %SPrio = 3,
+ SPrio = 4,
+ my_suspend(check_addN(SU,N,A,B,ApB,C,UO),SPrio,(A,B,C,ApB,UO)->suspend:constrained)
+ ; true)),
+ set_priority(Prio),
+ wake_if_other_scheduled(Prio)).
% INHIBE
@@ -523,170 +532,170 @@ factorize_addNsu_kill_ineqs(LSusp,SU,N,A,B,C,UO,NZUO,Continue) :-
; factorize_addNsu_kill_ineqs(EndLSusp,SU,N,A,B,C,UO,NZUO,Continue))
; Continue = 1).
-
factorize_addNsu(bvsl_bis(N,X,1,C),Susp,u,N,A,B,C,UOC,_,Goal,Continue) ?- !,
once (X == A; X == B),
protected_unify(A,B),
% Le mult add est gere par le bvsl_bis
Goal = true.
-%% En cas de débordement les gt/geq/diff_int sont redondants
+% En cas de débordement les gt/geq/diff_int sont redondants
+% DANGER si plus de deltas !!!
factorize_addNsu(gt(X,Y),Susp,_,_,A,B,C,UO,1,Goal,Continue) ?-
- %% UO <> 0
- (C == X,
- (A == Y; B == Y); %% C > A ou C > B
- C == Y,
- (A == X; B == X)), %% C < A ou C < B
- !,
- Goal = kill_suspension(Susp),
- Continue = 1.
+ % UO <> 0
+ getval(use_delta,1)@eclipse,
+ (C == X,
+ (A == Y; B == Y); %% C > A ou C > B
+ C == Y,
+ (A == X; B == X)), %% C < A ou C < B
+ !,
+ Goal = kill_suspension(Susp),
+ Continue = 1.
factorize_addNsu(geq(X,Y),Susp,_,_,A,B,C,UO,1,Goal,Continue) ?-
- (C == X,
- (A == Y; B == Y);
- C == Y,
- (A == X; B == X)),
- !,
- Goal = kill_suspension(Susp),
- Continue = 1.
+ getval(use_delta,1)@eclipse,
+ (C == X,
+ (A == Y; B == Y);
+ C == Y,
+ (A == X; B == X)),
+ !,
+ Goal = kill_suspension(Susp),
+ Continue = 1.
factorize_addNsu(diff_int(X,Y),Susp,_,_,A,B,C,UO,1,Goal,Continue) ?-
- (C == X,
- (A == Y; B == Y);
- C == Y,
- (A == X; B == X)),
- !,
- Goal = kill_suspension(Susp),
- Continue = 1.
+ getval(use_delta,1)@eclipse,
+ (C == X,
+ (A == Y; B == Y);
+ C == Y,
+ (A == X; B == X)),
+ !,
+ Goal = kill_suspension(Susp),
+ Continue = 1.
+
factorize_addNsu(check_opN(SU,N,X,_,Y,UOY),_,SU,N,A,B,C,UOC,_,Goal,Continue) ?-
- ((A,B) == (X,Y);
- (B,A) == (X,Y)),
- !,
- %% -X = Y + UOY*Size et X+Y = C + UOC*Size
- %% donc X+Y = -UOY*Size = C + UOC*Size donc C = -Size*(UOY+UOC)
- %% donc UOY+UOC = 0 et C = 0 et le check_addN est redondant
- Goal = (kill_addN(SU,N,A,B,C,UOC),op(UOC,UOY),C=0).
+ ((A,B) == (X,Y);
+ (B,A) == (X,Y)),
+ !,
+ % -X = Y + UOY*Size et X+Y = C + UOC*Size
+ % donc X+Y = -UOY*Size = C + UOC*Size donc C = -Size*(UOY+UOC)
+ % donc UOY+UOC = 0 et C = 0 et le check_addN est redondant
+ Goal = (kill_addN(SU,N,A,B,C,UOC),op(UOC,UOY),C=0).
-%% Inutile de regarder op_int pour A et B
-
factorize_addNsu(op_int(X,Y),_,_,_,A,B,C,UOC,_,Goal,Continue) ?-
- %% A + B = -A + UOC*2^N donc -2*A = B - UOC*2^N qui est beaucoup plus précis
- %% donc check_addN disparait et on tue A+B, UOC*2^N et C+UOC*2^N
- %% et on introduit op(UOC,OpUOC) et multN(SU,N,-2,A,B,OpUOC)
-%%!!!! faire comme dans arith ???
- ( C == X,
- (A == Y,Var=B; B == Y,Var=A)
- ; C == Y,
- (A == X,Var=B; B == X,Var=A)),
- !,
- Goal = launch_congr(Var,0,2),
- Continue = 1.
+ ( C == X,
+ (A == Y,Var=B; % A + B = -A + UOC*2^N -> B = -2A + UOC*2^N
+ B == Y,Var=A) % A + B = -B + UOC*2^N -> A = -2B + UOC*2^N
+ ; C == Y,
+ (A == X,Var=B; % A + B = -A + UOC*2^N -> B = -2A + UOC*2^N
+ B == X,Var=A)),% A + B = -B + UOC*2^N -> A = -2B + UOC*2^N
+ !,
+ Goal = launch_congr(Var,0,2),
+ Continue = 1.
factorize_addNsu(check_addN(SU,N,X,Y,XpY,Z,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_) ?-
- (A == X ->
- (B == Y ->
- %% A + B = C + ... et A + B = Z + ... ==> C = Z
- U1 = C,
- U2 = Z
- ; C == Z,
- %% A + B = C + UOC*Size et A + Y = C + UOZ*Size
- %% ==>
- %% Cas signé: UOC,UOZ : -1..1
- %% si UOC = -1 A,B < 0 et C > 0, UOZ : [-1,0] car A,B < 0
- %% si UOZ = 0, A+B=C-Size, A+Y=C donc Y-B=Size avec -2^(N-1)=<B<0 et 0<Y=<2^(N-1) -1
- %% donc Y-B =< 2^(N-1) -1 + 2^(N-1) < Size, CONTRADICTION
- %% donc UOZ = -1 et B = Y
- %% si UOC = 1 A,B > 0 et C < -1, UOZ : [0, 1] car A,B > 0
- %% si UOZ = 0, A+B=C+Size, A+Y=C donc B-Y=Size avec 0< B =< 2^(N-1)-1 et -2^(N-1)=<Y<0
- %% donc B-Y =< 2^(N-1) -1 + 2^(N-1) < Size, CONTRADICTION
- %% donc UOC=UOZ et B=Y
- %% Cas non signé: UOC,UOZ : 0..1 meme raisonnement si UOC = 1 alors UOZ = 1 donc B=Y
- U1 = B,
- U2 = Y)
- ; (A == Y ->
- (B == X ->
- %% A + B = C + ... et B + A + ... = Z ==> C = Z
- U1 = C,
- U2 = Z
- ; C == Z,
- %% A + B = C et X + A = C ==> B = X
- U1 = B,
- U2 = X)
- ; C == Z,
- (B == X ->
- %% A + B = C et B + Y = C ==> A = Y
- U1 = A,
- U2 = Y
- ; B == Y,
- %% A + B = C et X + B = C ==> A = X
- U1 = A,
- U2 = X))),
- Goal = (U1 = U2, true, UOC = UOZ).
+ (A == X ->
+ (B == Y ->
+ % A + B = C + ... et A + B = Z + ... ==> C = Z
+ U1 = C,
+ U2 = Z
+ ; C == Z,
+ % A + B = C + UOC*Size et A + Y = C + UOZ*Size
+ % ==>
+ % Cas signé: UOC,UOZ : -1..1
+ % si UOC = -1 A,B < 0 et C > 0, UOZ : [-1,0] car A,B < 0
+ % si UOZ = 0, A+B=C-Size, A+Y=C donc Y-B=Size avec -2^(N-1)=<B<0 et 0<Y=<2^(N-1) -1
+ % donc Y-B =< 2^(N-1) -1 + 2^(N-1) < Size, CONTRADICTION
+ % donc UOZ = -1 et B = Y
+ % si UOC = 1 A,B > 0 et C < -1, UOZ : [0, 1] car A,B > 0
+ % si UOZ = 0, A+B=C+Size, A+Y=C donc B-Y=Size avec 0< B =< 2^(N-1)-1 et -2^(N-1)=<Y<0
+ % donc B-Y =< 2^(N-1) -1 + 2^(N-1) < Size, CONTRADICTION
+ % donc UOC=UOZ et B=Y
+ % Cas non signé: UOC,UOZ : 0..1 meme raisonnement si UOC = 1 alors UOZ = 1 donc B=Y
+ U1 = B,
+ U2 = Y)
+ ; (A == Y ->
+ (B == X ->
+ % A + B = C + ... et B + A + ... = Z ==> C = Z
+ U1 = C,
+ U2 = Z
+ ; C == Z,
+ % A + B = C et X + A = C ==> B = X
+ U1 = B,
+ U2 = X)
+ ; C == Z,
+ (B == X ->
+ % A + B = C et B + Y = C ==> A = Y
+ U1 = A,
+ U2 = Y
+ ; B == Y,
+ % A + B = C et X + B = C ==> A = X
+ U1 = A,
+ U2 = X))),
+ Goal = (protected_unify(U1,U2),protected_unify(UOC,UOZ)).
factorize_addNsu(add_int(X,_,Y,_,C,_),_,SU,N,A,B,C,UOC,_,Goal,_) ?-
- %% Si (A,B) == (X,Y) ou (Y,X) il n'y a pas de factorisation à faire, elle
- %% est déjà traitée dans les entiers
- %%
- %% Pour le projections inverses, si (A,C) ou (B,C) == (X,Z) ou (Y,Z)
- %% on peut factoriser et déduire UOC=0 quand le range de Y ou X tient dans Min..Max
- %% En effet pour A + B = C + UOC*2^N et A + Y = C
- %% on a alors C - Y = A et C - B = A - UOC*2^N donc B-Y = UOC*2^N
- %% or dans le cas signé on a
- %% -2^N < -2^(N-1) - (2^(N-1) - 1) =< B-Y =< 2^(N-1) - 1 + 2^(N-1) < 2^N donc UOC = 0
- %% et le cas non signé a
- %% -2^N < 0 - 2^(N-1) =< B-Y =< 2^(N-1) < 2^N donc UOC = 0
- %% Inutile de tuer le add_int, il se factorisera tout seul
-
- %% C == Z,
- (A == X ->
- B \== Y,
- %% A + B = C + UOC*Size et A + Y = C
- mfd:dvar_range(Y,MinY,MaxY),
- intN_min_max(SU,N,Min,Max),
- Min =< MinY,
- MaxY =< Max,
- U1 = B,
- U2 = Y
- ; (A == Y ->
- B \== X,
- %% A + B = C + UOC*Size et X + A = C
- mfd:dvar_range(X,MinX,MaxX),
- intN_min_max(SU,N,Min,Max),
- Min =< MinX,
- MaxX =< Max,
- U1 = B,
- U2 = X
- ; (B == X ->
- %% A \== Y,
- %% A + B = C + UOC*Size et B + Y = C
- mfd:dvar_range(Y,MinY,MaxY),
- intN_min_max(SU,N,Min,Max),
- Min =< MinY,
- MaxY =< Max,
- U1 = A,
- U2 = Y
- ; B == Y,
- %% A \== X,
- %% A + B = C + UOC*Size et X + B = C
- mfd:dvar_range(X,MinX,MaxX),
- intN_min_max(SU,N,Min,Max),
- Min =< MinX,
- MaxX =< Max,
- U1 = A,
- U2 = X))),
- Goal = (U1 = U2, true, UOC = 0).
+ % Si (A,B) == (X,Y) ou (Y,X) il n'y a pas de factorisation à faire, elle
+ % est déjà traitée dans les entiers
+ %
+ % Pour le projections inverses, si (A,C) ou (B,C) == (X,Z) ou (Y,Z)
+ % on peut factoriser et déduire UOC=0 quand le range de Y ou X tient dans Min..Max
+ % En effet pour A + B = C + UOC*2^N et A + Y = C
+ % on a alors C - Y = A et C - B = A - UOC*2^N donc B-Y = UOC*2^N
+ % or dans le cas signé on a
+ % -2^N < -2^(N-1) - (2^(N-1) - 1) =< B-Y =< 2^(N-1) - 1 + 2^(N-1) < 2^N donc UOC = 0
+ % et le cas non signé a
+ % -2^N < 0 - 2^(N-1) =< B-Y =< 2^(N-1) < 2^N donc UOC = 0
+ % Inutile de tuer le add_int, il se factorisera tout seul
+
+ % C == Z,
+ (A == X ->
+ B \== Y,
+ % A + B = C + UOC*Size et A + Y = C
+ mfd:dvar_range(Y,MinY,MaxY),
+ intN_min_max(SU,N,Min,Max),
+ Min =< MinY,
+ MaxY =< Max,
+ U1 = B,
+ U2 = Y
+ ; (A == Y ->
+ B \== X,
+ % A + B = C + UOC*Size et X + A = C
+ mfd:dvar_range(X,MinX,MaxX),
+ intN_min_max(SU,N,Min,Max),
+ Min =< MinX,
+ MaxX =< Max,
+ U1 = B,
+ U2 = X
+ ; (B == X ->
+ % A \== Y,
+ % A + B = C + UOC*Size et B + Y = C
+ mfd:dvar_range(Y,MinY,MaxY),
+ intN_min_max(SU,N,Min,Max),
+ Min =< MinY,
+ MaxY =< Max,
+ U1 = A,
+ U2 = Y
+ ; B == Y,
+ % A \== X,
+ % A + B = C + UOC*Size et X + B = C
+ mfd:dvar_range(X,MinX,MaxX),
+ intN_min_max(SU,N,Min,Max),
+ Min =< MinX,
+ MaxX =< Max,
+ U1 = A,
+ U2 = X))),
+ Goal = (protected_unify(U1,U2),protected_unify(UOC,0)).
factorize_addNsu(check_multN(SU,N,X,Y,Res,Z,_,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_) ?-
- %% A <> B
- (X == 2->
- factorize_addNsu(check_addN(SU,N,Y,Y,Res,Z,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_)
- ; Y == 2,
- factorize_addNsu(check_addN(SU,N,X,X,Res,Z,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_)).
+ % A <> B
+ (X == 2->
+ factorize_addNsu(check_addN(SU,N,Y,Y,Res,Z,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_)
+ ; Y == 2,
+ factorize_addNsu(check_addN(SU,N,X,X,Res,Z,UOZ),_,SU,N,A,B,C,UOC,_,Goal,_)).
factorize_addNsu(mult_int(X,_,Y,_,Z,_),_,SU,N,A,B,C,UOC,_,Goal,_) ?- !,
- %% A <> B
- (X == 2->
- factorize_addNsu(add_int(Y,_,Y,_,Z,_),_,SU,N,A,B,C,UOC,_,Goal,_)
- ; Y == 2,
- factorize_addNsu(add_int(X,_,X,_,Z,_),_,SU,N,A,B,C,UOC,_,Goal,_)).
+ % A <> B
+ (X == 2->
+ factorize_addNsu(add_int(Y,_,Y,_,Z,_),_,SU,N,A,B,C,UOC,_,Goal,_)
+ ; Y == 2,
+ factorize_addNsu(add_int(X,_,X,_,Z,_),_,SU,N,A,B,C,UOC,_,Goal,_)).
%% On fait disparaitre les contraintes d'un check_addN
@@ -1093,8 +1102,10 @@ minusNs(N,A,B,C,UO) :-
op_int(UO,OpUO),
addNs(N,B,C,A,OpUO).
+/*
minusNu(N,0,B,C,UO) ?- !,
opNu(N,B,C,UO).
+*/
%% Autre definition
/*
@@ -1194,37 +1205,42 @@ opNsu(SU,N,A,OpA,UO) :-
check_opN(SU,N,A,IOpA,OpA,UO) :-
- ((nonvar(UO);
- nonvar(A);
- nonvar(OpA))
- ->
- true
+/*
+ ((nonvar(UO);
+ nonvar(A);
+ nonvar(OpA))
+ ->
+*/
+ (ground((A,IOpA,OpA,UO)) ->
+ true
; get_priority(Prio),
- set_priority(1),
- save_cstr_suspensions((A,OpA)),
- intN_min_max(SU,N,Min,Max),
- mfd:dvar_range(IOpA,LIOpA,HIOpA),
- (Min =< LIOpA ->
- %% Pas de débordement négatif
- (LIOpA > Max ->
- %% Débordement positif
- UO = 1
- ; mfd:dvar_remove_smaller(UO,0))
- ; true),
- (HIOpA =< Max ->
- %% Pas de débordement positif
- (HIOpA < Min ->
- %% Débordement négatif
- UO = -1
- ; mfd:dvar_remove_greater(UO,0))
- ; true),
- saturate_opNus_inequalities(Min,Max,A,OpA),
- apply_opN_UO(Min,Max,A,OpA,UO,Continue),
- (var(Continue) ->
- true
- ; check_before_susp_opN(SU,N,A,IOpA,OpA,UO)),
- set_priority(Prio),
- wake_if_other_scheduled(Prio)).
+ set_priority(1),
+ save_cstr_suspensions((A,OpA)),
+ intN_min_max(SU,N,Min,Max),
+ mfd:dvar_range(IOpA,LIOpA,HIOpA),
+ (Min =< LIOpA ->
+ % Pas de débordement négatif
+ (LIOpA > Max ->
+ % Débordement positif
+ UO = 1
+ ; mfd:dvar_remove_smaller(UO,0))
+ ; true),
+ (HIOpA =< Max ->
+ % Pas de débordement positif
+ (HIOpA < Min ->
+ % Débordement négatif
+ UO = -1
+ ; mfd:dvar_remove_greater(UO,0))
+ ; true),
+ saturate_opNus_inequalities(Min,Max,A,OpA),
+ apply_opN_UO(Min,Max,A,OpA,UO,Continue),
+ ((var(Continue),
+ ground((A,IOpA,OpA,UO)))
+ ->
+ true
+ ; check_before_susp_opN(SU,N,A,IOpA,OpA,UO)),
+ set_priority(Prio),
+ wake_if_other_scheduled(Prio)).
@@ -1250,70 +1266,70 @@ opNsu_intervals(SU,N,A,OpA,UO) :-
apply_opN_UO(Min,Max,A,B,UO,Continue) :-
- var(UO),
- %% Donc A et B acceptent Min
- !,
- get_rel_between_intN_args(Min,Max,A,B,Rel,_),
- (Min == 0 ->
- %% Cas non signé
- Continue = 1,
- Sd2 is (Max+1) // 2,
- apply_opN_UO_unsigned(Rel,Sd2,Max,A,B,UO)
- ; %% Cas signé
- (occurs(Rel,('#','>','<')) ->
- UO = 0
- ; apply_opN_UO_signed(Rel,Min,Max,A,B),
- Continue = 1)).
+ var(UO),
+ % Donc A et B acceptent Min
+ !,
+ get_rel_between_intN_args(Min,Max,A,B,Rel,_),
+ (Min == 0 ->
+ % Cas non signé
+ Continue = 1,
+ Sd2 is (Max+1) // 2,
+ apply_opN_UO_unsigned(Rel,Sd2,Max,A,B,UO)
+ ; % Cas signé
+ (occurs(Rel,('#','>','<')) ->
+ UO = 0
+ ; apply_opN_UO_signed(Rel,Min,Max,A,B),
+ Continue = 1)).
apply_opN_UO(_,_,A,B,0,_).
apply_opN_UO(Min,Max,A,B,-1,Continue) :-
- %% Débordement négatif
- %% cas non signé
- Continue = 1,
- mfd:dvar_remove_element(A,0),
- mfd:dvar_remove_element(B,0),
- get_rel_between_intN_args(Min,Max,A,B,Rel,_),
- Sd2 is (Max+1)//2,
- apply_opN_UO_unsigned(Rel,Sd2,Max,A,B,_).
+ % Débordement négatif
+ % cas non signé
+ Continue = 1,
+ mfd:dvar_remove_element(A,0),
+ mfd:dvar_remove_element(B,0),
+ get_rel_between_intN_args(Min,Max,A,B,Rel,_),
+ Sd2 is (Max+1)//2,
+ apply_opN_UO_unsigned(Rel,Sd2,Max,A,B,_).
apply_opN_UO(Min,Max,A,B,1,_) :-
- %% cas signé
- A = Min,
- B = Min.
+ % cas signé
+ A = Min,
+ B = Min.
apply_opN_UO_unsigned('?',Sd2,Max,A,B,UO) :- !.
apply_opN_UO_unsigned('=',Sd2,Max,A,B,UO) :-
- mfd:set_intervals(A,[0,Sd2]),
- A = B.
+ mfd:set_intervals(A,[0,Sd2]),
+ A = B.
apply_opN_UO_unsigned('#',Sd2,Max,A,B,UO) :- !,
- UO = -1,
- mfd:dvar_remove_element(A,0),
- mfd:dvar_remove_element(A,Sd2),
- mfd:dvar_remove_element(B,0),
- mfd:dvar_remove_element(B,Sd2).
+ UO = -1,
+ mfd:dvar_remove_element(A,0),
+ mfd:dvar_remove_element(A,Sd2),
+ mfd:dvar_remove_element(B,0),
+ mfd:dvar_remove_element(B,Sd2).
apply_opN_UO_unsigned('<',Sd2,Max,A,B,UO) :- !,
- UO = -1,
- PSd2 is Sd2 - 1,
- NSd2 is Sd2 + 1,
- mfd:dvar_remove_element(A,0),
- mfd:dvar_remove_greater(A,PSd2),
- mfd:dvar_remove_smaller(B,NSd2).
+ UO = -1,
+ PSd2 is Sd2 - 1,
+ NSd2 is Sd2 + 1,
+ mfd:dvar_remove_element(A,0),
+ mfd:dvar_remove_greater(A,PSd2),
+ mfd:dvar_remove_smaller(B,NSd2).
apply_opN_UO_unsigned('=<',Sd2,Max,A,B,UO) :- !,
- %% On doit garder 0 et Sd2 si ils sont là
- mfd:get_intervals(A,IA),
- (number_in_interval(IA,0) ->
- mfd:get_intervals(B,IB),
- (number_in_interval(IB,0) ->
- true
- ; UO = -1,
- mfd:dvar_remove_element(A,0))
- ; UO = -1,
- mfd:dvar_remove_element(B,0)),
- mfd:dvar_remove_greater(A,Sd2),
- mfd:dvar_update(B,dom([0,Sd2..Max])).
+ % On doit garder 0 et Sd2 si ils sont là
+ mfd:get_intervals(A,IA),
+ (number_in_interval(IA,0) ->
+ mfd:get_intervals(B,IB),
+ (number_in_interval(IB,0) ->
+ true
+ ; UO = -1,
+ mfd:dvar_remove_element(A,0))
+ ; UO = -1,
+ mfd:dvar_remove_element(B,0)),
+ mfd:dvar_remove_greater(A,Sd2),
+ mfd:dvar_update(B,dom([0,Sd2..Max])).
apply_opN_UO_unsigned('>',Sd2,Max,A,B,UO) :- !,
- apply_opN_UO_unsigned('<',Sd2,Max,B,A,UO).
+ apply_opN_UO_unsigned('<',Sd2,Max,B,A,UO).
apply_opN_UO_unsigned('>=',Sd2,Max,A,B,UO) :-
- apply_opN_UO_unsigned('=<',Sd2,Max,B,A,UO).
+ apply_opN_UO_unsigned('=<',Sd2,Max,B,A,UO).
/* CAS INUTILES
@@ -1327,35 +1343,33 @@ apply_opN_UO_signed('>',Min,Max,A,B) :-
*/
apply_opN_UO_signed('?',_,_,_,_).
apply_opN_UO_signed('=',Min,Max,A,B) :-
- mfd:set_intervals(A,[Min,0]),
- A = B.
+ mfd:set_intervals(A,[Min,0]),
+ A = B.
apply_opN_UO_signed('>=',Min,Max,A,B) :-
- %% A positif U -8, B négatif
- mfd:dvar_update(A,dom([Min,0..Max])),
- mfd:dvar_remove_greater(B,0).
+ % A positif U -8, B négatif
+ mfd:dvar_update(A,dom([Min,0..Max])),
+ mfd:dvar_remove_greater(B,0).
apply_opN_UO_signed('=<',Min,Max,A,B) :-
- apply_opN_UO_signed('>=',Min,Max,B,A).
+ apply_opN_UO_signed('>=',Min,Max,B,A).
check_before_susp_opN(SU,N,A,IOpA,B,UO) :-
- get_saved_cstr_suspensions(LSusp),
- ((member((Susp,Goal),LSusp),
- factorize_opN(Goal,Susp,SU,N,A,B,UO,Call,Continue))
- ->
- call(Call)
- ; Continue = 1),
- ((var(Continue);
- UO == 0;
- nonvar(A);
- nonvar(B))
- ->
- true
- ; %Prio = 3,
- Prio = 5,
- my_suspend(check_opN(SU,N,A,IOpA,B,UO),Prio,(A,IOpA,B,UO) -> suspend:constrained)).
+ get_saved_cstr_suspensions(LSusp),
+ ((member((Susp,Goal),LSusp),
+ factorize_opN(Goal,Susp,SU,N,A,B,UO,Call,Continue))
+ ->
+ call(Call)
+ ; Continue = 1),
+ ((var(Continue),
+ ground((A,IOpA,B,UO)))
+ ->
+ true
+ ; %Prio = 3,
+ Prio = 5,
+ my_suspend(check_opN(SU,N,A,IOpA,B,UO),Prio,(A,IOpA,B,UO) -> suspend:constrained)).
@@ -1363,55 +1377,57 @@ check_before_susp_opN(SU,N,A,IOpA,B,UO) :-
FACTORISATIONS DE opN
INUTILE POUR GT CAR IL DISPARAIT
*/
+/*
factorize_opN(diff_int(X,Y),Susp,u,_,A,B,_,Goal,Continue) ?-
- ((A,B) == (X,Y);
- (A,B) == (Y,X)),!,
- %% Cas non signé le diff_int peut disparaitre
- %% car son delta est géré par opNu
- Goal = kill_suspension(Susp),
- Continue = 1.
+ ((A,B) == (X,Y);
+ (A,B) == (Y,X)),!,
+ % Cas non signé le diff_int peut disparaitre
+ % car son delta est géré par opNu
+ Goal = kill_suspension(Susp),
+ Continue = 1.
factorize_opN(geq(X,Y),Susp,_,_,A,B,_,Goal,Continue) ?-
- ((A,B) == (X,Y);
- (A,B) == (Y,X)),!,
- %% Cas signé ou non signé, le geq peut disparaitre
- %% car son delta est géré par opN
- Goal = kill_suspension(Susp),
- Continue = 1.
+ ((A,B) == (X,Y);
+ (A,B) == (Y,X)),!,
+ % Cas signé ou non signé, le geq peut disparaitre
+ % car son delta est géré par opN
+ Goal = kill_suspension(Susp),
+ Continue = 1.
+*/
factorize_opN(check_opN(SU,N,X,IOpX,Y,UOY),Susp,SU,N,A,B,UOB,Goal,_) ?-
-%% TOUS LES CAS ONT ETE VERIFIES UN PAR UN
- (A == X ->
- %% -A = B + UOB*Size et -A = Y + UOY*Size
- %% donc UOB = UOY (meme débordement pour -A) et B = Y
- Unif1 = B,
- Unif2 = Y
- ; (A == Y ->
- %% -A = B + UOB*Size et -X = A + UOY*Size
- %% ie -A = B + UOB*Size et -A = X + UOY*Size
- %% (meme débordement pour -A) donc X = B
- Unif1 = B,
- Unif2 = X
- ; (B == X ->
- %% -A = B + UOB*Size et -B = Y + UOY*Size
- %% ie -B = A + UOB*Size et -B = Y + UOY*Size
- %% (meme débordement pour -B) donc Y = A
- Unif1 = A,
- Unif2 = Y
- ; B == Y,
- %% -A = B + UOB*Size et -X = B + UOY*Size
- %% ie -B = A + UOB*Size et -B = X + UOY*Size
- %% (meme débordement pour -B) donc X = A
- Unif1 = A,
- Unif2 = X))),
- !,
- %% On garde tout, les unifications feront les factorisations
- Goal = (protected_unify(UOB,UOY),protected_unify(Unif1,Unif2)).
+ % TOUS LES CAS ONT ETE VERIFIES UN PAR UN
+ (A == X ->
+ % -A = B + UOB*Size et -A = Y + UOY*Size
+ % donc UOB = UOY (meme débordement pour -A) et B = Y
+ Unif1 = B,
+ Unif2 = Y
+ ; (A == Y ->
+ % -A = B + UOB*Size et -X = A + UOY*Size
+ % ie -A = B + UOB*Size et -A = X + UOY*Size
+ % (meme débordement pour -A) donc X = B
+ Unif1 = B,
+ Unif2 = X
+ ; (B == X ->
+ % -A = B + UOB*Size et -B = Y + UOY*Size
+ % ie -B = A + UOB*Size et -B = Y + UOY*Size
+ % (meme débordement pour -B) donc Y = A
+ Unif1 = A,
+ Unif2 = Y
+ ; B == Y,
+ % -A = B + UOB*Size et -X = B + UOY*Size
+ % ie -B = A + UOB*Size et -B = X + UOY*Size
+ % (meme débordement pour -B) donc X = A
+ Unif1 = A,
+ Unif2 = X))),
+ !,
+ % On garde tout, les unifications feront les factorisations
+ Goal = (protected_unify(UOB,UOY),protected_unify(Unif1,Unif2)).
factorize_opN(check_addN(SU,N,X,Y,XpY,Z,UOZ),Susp,SU,N,A,B,UOB,Goal,Continue) ?-
- ((A,B) == (X,Y);
- (A,B) == (Y,X)),
- !,
- %% on réveille le check_addN pour qu'il disparaisse proprement
- Continue = 1,
- Goal = schedule_suspensions(1,s([Susp])).
+ ((A,B) == (X,Y);
+ (A,B) == (Y,X)),
+ !,
+ % on réveille le check_addN pour qu'il disparaisse proprement
+ Continue = 1,
+ Goal = schedule_suspensions(1,s([Susp])).
%% check_multN ?
@@ -1421,98 +1437,105 @@ factorize_opN(check_addN(SU,N,X,Y,XpY,Z,UOZ),Susp,SU,N,A,B,UOB,Goal,Continue) ?-
%% on doit donc se protéger.
kill_opN(N,A,B,UO) :- !.
kill_opN(N,A,B,UO) :-
- (kill_opN1(N,A,B,UO) ->
- true
- ; true).
+ (kill_opN1(N,A,B,UO) ->
+ true
+ ; true).
kill_opN1(N,A,B,UO) :-
- %% -A = B + UO*Size
- %% On tue -A, UO*Size et B+UO*Size
- get_saved_cstr_suspensions(LSusp),
- member_begin_end((Susp1,op_int(CA,OpA)),LSusp,LSusp1,E1,E1),
- CA == A,!,
- kill_suspension(Susp1),
- member((Susp2,add_int(CB,_,UOSize,_,COpA,_)),LSusp1),
- (CB,COpA) == (B,OpA),!,
- kill_suspension(Susp2),
- Size is 2^N,
- suspensions(UO,LSuspK),
- member(Susp3,LSuspK),
- get_suspension_data(Susp3,goal,mult_int(CSize,_,CUO,_,_,_)),
- (CSize,CUO) == (Size,UO),!,
- kill_suspension(Susp3).
+ % -A = B + UO*Size
+ % On tue -A, UO*Size et B+UO*Size
+ get_saved_cstr_suspensions(LSusp),
+ member_begin_end((Susp1,op_int(CA,OpA)),LSusp,LSusp1,E1,E1),
+ CA == A,!,
+ kill_suspension(Susp1),
+ member((Susp2,add_int(CB,_,UOSize,_,COpA,_)),LSusp1),
+ (CB,COpA) == (B,OpA),!,
+ kill_suspension(Susp2),
+ Size is 2^N,
+ suspensions(UO,LSuspK),
+ member(Susp3,LSuspK),
+ get_suspension_data(Susp3,goal,mult_int(CSize,_,CUO,_,_,_)),
+ (CSize,CUO) == (Size,UO),!,
+ kill_suspension(Susp3).
saturate_opN_inequalities(Min,Max,A,B):-
- %% On a déjà appliqué la première projection
- ((var(A),
- var(B))
- ->
- saturate_opNus_inequalities(Min,Max,A,B)
- ; true).
+ % On a déjà appliqué la première projection
+ ((var(A),
+ var(B))
+ ->
+ saturate_opNus_inequalities(Min,Max,A,B)
+ ; true).
-saturate_opNus_inequalities(0,Max,A,B):- !,
- %% Cas non signé
- %% si A =< Max//2 (eg 0..7 pour N=4) alors
- %% C = +, et le déplacement est positif (0,14,12,.. 2,0)
- %% Si A >= Max//2, le déplacement est négatif (0,-2, ..,-14)
- %% Sinon déplacement non signé
- mfd:get_intervals(B,IB),
- interval_range(IB,MinB,MaxB),
- Size is Max + 1,
- (MinB == 0 ->
- %% On doit garder 0 dans le delta
- get_suc_min_interval(IB,SMinB),
- MinS is min(0,2*SMinB - Size),
- MaxS is max(0,2*MaxB - Size),
- S = '+'
- ; MinS is 2*MinB - Size,
- MaxS is 2*MaxB - Size,
- Mid is Size//2,
- (number_in_interval(IB,Mid) ->
- S = '+'
- ; S = '#')),
- launch_delta_opN(A,B,S,MinS,MaxS).
+saturate_opNus_inequalities(0,Max,A,B):-
+ var(A),
+ var(B),
+ !,
+ % Cas non signé
+ % si A =< Max//2 (eg 0..7 pour N=4) alors
+ % C = +, et le déplacement est positif (0,14,12,.. 2,0)
+ % Si A >= Max//2, le déplacement est négatif (0,-2, ..,-14)
+ % Sinon déplacement non signé
+ mfd:get_intervals(B,IB),
+ interval_range(IB,MinB,MaxB),
+ Size is Max + 1,
+ (MinB == 0 ->
+ % On doit garder 0 dans le delta
+ get_suc_min_interval(IB,SMinB),
+ MinS is min(0,2*SMinB - Size),
+ MaxS is max(0,2*MaxB - Size),
+ S = '+'
+ ; MinS is 2*MinB - Size,
+ MaxS is 2*MaxB - Size,
+ Mid is Size//2,
+ (number_in_interval(IB,Mid) ->
+ S = '+'
+ ; S = '#')),
+ launch_delta_opN(A,B,S,MinS,MaxS).
saturate_opNus_inequalities(Min,_,A,B):-
- %% Cas signé
- mfd:get_intervals(B,IB),
- mfd:maxdomain(B,MaxB),
- (number_in_interval(IB,Min) ->
- get_suc_min_interval(IB,SMinB),
- MinS is min(0,2*SMinB),
- MaxS is max(0,2*MaxB),
- S = '+'
- ; mfd:mindomain(B,MinB),
- MinS is 2*MinB,
- MaxS is 2*MaxB,
- (number_in_interval(IB,0) ->
- S = '+'
- ; S = '#')),
- launch_delta_opN(A,B,S,MinS,MaxS).
+ var(A),
+ var(B),
+ !,
+ % Cas signé
+ mfd:get_intervals(B,IB),
+ mfd:maxdomain(B,MaxB),
+ (number_in_interval(IB,Min) ->
+ get_suc_min_interval(IB,SMinB),
+ MinS is min(0,2*SMinB),
+ MaxS is max(0,2*MaxB),
+ S = '+'
+ ; mfd:mindomain(B,MinB),
+ MinS is 2*MinB,
+ MaxS is 2*MaxB,
+ (number_in_interval(IB,0) ->
+ S = '+'
+ ; S = '#')),
+ launch_delta_opN(A,B,S,MinS,MaxS).
+saturate_opNus_inequalities(_,_,_,_).
get_suc_min_interval([I|LI],SMin) :-
- (integer(I) ->
- LI = [I1|_],
- min_max_inter(I1,SMin,_)
- ; min_max_inter(I,Min,_),
- SMin is Min + 1).
+ (integer(I) ->
+ LI = [I1|_],
+ min_max_inter(I1,SMin,_)
+ ; min_max_inter(I,Min,_),
+ SMin is Min + 1).
%%launch_delta_opN(A,B,S,MinS,MaxS) :- !.
launch_delta_opN(A,B,S,MinS,MaxS) :-
- (ndelta:get_deltas(A,B,OS,OC) ->
- ndelta:deltas_inter(OS,OC,S,MinS..MaxS,NS0,NC0,_),
- %% La distance doit etre paire
- reduce_congr_bounds_interval_list([NC0],0,2,NIL),
- (NIL = [NC] ->
- (number(NC) ->
- NS = '='
- ; NS = NS0)
- ; NS = NS0,
- interval_range(NIL,NMin,NMax),
- NC = NMin..NMax)
- ; NS = S,
- NC = MinS..MaxS),
- launch_delta(A,B,NS,NC).
+ (ndelta:get_deltas(A,B,OS,OC) ->
+ ndelta:deltas_inter(OS,OC,S,MinS..MaxS,NS0,NC0,_),
+ % La distance doit etre paire
+ reduce_congr_bounds_interval_list([NC0],0,2,NIL),
+ (NIL = [NC] ->
+ (number(NC) ->
+ NS = '='
+ ; NS = NS0)
+ ; NS = NS0,
+ interval_range(NIL,NMin,NMax),
+ NC = NMin..NMax)
+ ; NS = S,
+ NC = MinS..MaxS),
+ launch_delta(A,B,NS,NC).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Multiplications signée et non-signée
@@ -1609,6 +1632,10 @@ multNsu(SU,N,A,B,C,UO) :-
%% On gère le lien entre K et UO,
%% les identités et les factorisations
+check_multN(SU,N,A,B,Res,C,K,UO) :-
+ ground((A,B,Res,C,K,UO)),
+ !.
+/*
check_multN(SU,N,A,B,Res,C,K,0) ?- !,
% L'arithmétique normale travaille
K = 0,
@@ -1627,6 +1654,7 @@ check_multN(SU,N,A,-1,Res,C,K,UO) ?- !,
K = UO,
op(A,Res),
check_opN(SU,N,A,Res,C,UO).
+*/
check_multN(SU,N,A,B,Res,C,K,UO) :-
get_priority(Prio),
set_priority(1),
@@ -1650,11 +1678,15 @@ check_multN(SU,N,A,B,Res,C,K,UO) :-
; mfd:dvar_remove_greater(UO,0))
; true),
check_multNbis(SU,N,A,B,Res,C,K,UO,Continue),
- (var(Continue) ->
+ ((var(Continue),
+ ground((A,B,Res,C,K,UO)))
+ ->
true
; setval(saved_suspensions,LSusp),
factorize_multNsu(SU,N,A,B,C,K,UO,Continue1),
- (var(Continue1) ->
+ ((var(Continue1),
+ ground((A,B,Res,C,K,UO)))
+ ->
true
; %SPrio = 3,
SPrio = 4,
@@ -1690,9 +1722,9 @@ check_multNbis(SU,N,A,B,Res,C,K,UO,Continue) :-
%%
%% si A et B <> 0 alors débordement certain car K*Size <> 0 donc K et UO <> 0
- (((is_odd(A), %% A impair ne divise pas 2^N donc B = 0
+ (((is_odd(int,A), %% A impair ne divise pas 2^N donc B = 0
Var = B);
- (is_odd(B), %% B impair ne divise pas 2^N donc A = 0
+ (is_odd(int,B), %% B impair ne divise pas 2^N donc A = 0
Var = A))
->
UO = 0,
@@ -1734,10 +1766,10 @@ check_multNbis(SU,N,A,B,Res,A,K,UO,Continue) ?- !,
%%
%% Si A <> 0 et B <> 1 alors débordement certain car k*Size <> 0
- (((is_odd(A), %% A impair et B = 1
+ (((is_odd(int,A), %% A impair et B = 1
Var = B,
Val = 1);
- (is_even(B), %% B pair et A = 0
+ (is_even(int,B), %% B pair et A = 0
Var = A,
Val = 0))
->
@@ -1765,39 +1797,39 @@ check_multNbis(SU,N,A,B,Res,A,K,UO,Continue) ?- !,
%% B*A = A[Size]
check_multNbis(SU,N,B,A,Res,A,K,UO,Continue) ?- !,
- check_multNbis(SU,N,A,B,Res,A,K,UO,Continue).
+ check_multNbis(SU,N,A,B,Res,A,K,UO,Continue).
check_multNbis(SU,N,A,B,Res,C,K,UO,Continue) :-
- (not_unify(C,0) ->
- true
- ; %% A*B = C + K*2^N
- %% Si K <> 0 alors A et B <> 0 et 1,
- %% Si A (ou B) impair alors C <> 0
- %% car si C = 0 on a gcd(A,2^N) = 1 avec A*B = 0[2^N] = 0[A]
- %% donc A*B = 0[A*2^N] ie, B = 0[2^N] donc B = 0 (abs(B) < 2^N)
- %% ce qui contredit B<>0 (ou A<>0)
- ((not_unify(K,0),
- (is_odd(A);
- is_odd(B)))
- ->
- mfd:dvar_remove_element(C,0)
- ; true)),
- check_UO_K(A,B,C,K,UO,Continue).
+ (not_unify(C,0) ->
+ true
+ ; % A*B = C + K*2^N
+ % Si K <> 0 alors A et B <> 0 et 1,
+ % Si A (ou B) impair alors C <> 0
+ % car si C = 0 on a gcd(A,2^N) = 1 avec A*B = 0[2^N] = 0[A]
+ % donc A*B = 0[A*2^N] ie, B = 0[2^N] donc B = 0 (abs(B) < 2^N)
+ % ce qui contredit B<>0 (ou A<>0)
+ ((not_unify(K,0),
+ (is_odd(int,A);
+ is_odd(int,B)))
+ ->
+ mfd:dvar_remove_element(C,0)
+ ; true)),
+ check_UO_K(A,B,C,K,UO,Continue).
check_UO_K(A,B,C,K,UO,Continue) :-
- % invariant: abs(K) >= abs(UO)
+ % invariant: abs(K) >= abs(UO)
abs_val(K,AbsK),
abs_val(UO,AbsUO),
launch_geq(AbsK,AbsUO),
check_UO_K(K,UO),
- ((var(UO),
- UO \== K; %% On garde le check_multN pour le calcul de UO
- UO \== 0,
- term_variables([A,B,C],[_,_|_]))
- ->
- Continue = 1
- ; true).
+ ((var(UO),
+ UO \== K; %% On garde le check_multN pour le calcul de UO
+ UO \== 0,
+ term_variables([A,B,C],[_,_|_]))
+ ->
+ Continue = 1
+ ; true).
check_UO_K(K,K) ?- !.
check_UO_K(K,UO) :-
@@ -1858,11 +1890,11 @@ check_UO_K(K,UO) :-
% INHIBE
%factorize_multNsu(SU,N,A,B,C,K,UO,1) :- !.
factorize_multNsu(SU,N,A,B,C,K,UO,Continue) :-
- get_saved_cstr_suspensions(LSusp),
- (not_unify(UO,0) ->
- NZUO = 1
- ; true),
- factorize_multNsu(LSusp,SU,N,A,B,C,K,UO,NZUO,Continue).
+ get_saved_cstr_suspensions(LSusp),
+ (not_unify(UO,0) ->
+ NZUO = 1
+ ; true),
+ factorize_multNsu(LSusp,SU,N,A,B,C,K,UO,NZUO,Continue).
factorize_multNsu(LSusp,SU,N,A,B,C,K,UO,NZUO,Continue) :-
((member_begin_end((Susp,Goal),LSusp,_,_,EndLSusp),
@@ -1893,6 +1925,7 @@ factorize_multNsu(check_multN(SU,N,X,Y,_,Z,KZ,UOZ),_,SU,N,A,B,C,KC,UOC,_,Goal,_)
U2 = Z
; % On peut factoriser sur les projections inverses
% quand les débordements sont identiques
+ not_unify(C,0),
C == Z,
KC == KZ,
% A * B = C et A * Y = C ==> B = Y
@@ -1904,11 +1937,13 @@ factorize_multNsu(check_multN(SU,N,X,Y,_,Z,KZ,UOZ),_,SU,N,A,B,C,KC,UOC,_,Goal,_)
U1 = C,
U2 = Z
; % A * B = C et X * A = Z ==> B = X
+ not_unify(C,0),
C == Z,
KC == KZ,
U1 = B,
U2 = X)
- ; C == Z,
+ ; not_unify(C,0),
+ C == Z,
KC == KZ,
(B == X ->
% A * B = C et B * Y = C ==> A = Y
@@ -1918,9 +1953,10 @@ factorize_multNsu(check_multN(SU,N,X,Y,_,Z,KZ,UOZ),_,SU,N,A,B,C,KC,UOC,_,Goal,_)
% A * B = C et X * B = C ==> A = X
U1 = A,
U2 = X))),
- Goal = (U1 = U2, true, UOC = UOZ, true, KC = KZ).
+ Goal = (protected_unify(U1,U2),protected_unify(UOC,UOZ),protected_unify(KC,KZ)).
factorize_multNsu(check_powerN(SU,N,X,P,_,Z,KZ,UOZ),_,SU,N,A,B,C,KC,UOC,_,Goal,_) ?- !,
+ not_unify(C,0),
(X == A ->
B == Z
% A * A^P = C => A^(P+1) = C
@@ -1932,6 +1968,7 @@ factorize_multNsu(check_powerN(SU,N,X,P,_,Z,KZ,UOZ),_,SU,N,A,B,C,KC,UOC,_,Goal,_
Goal = (SP is P + 1,kill_multN(mult,_,SU,N,A,B,C,KC),powerNsu(SU,N,X,SP,C,UOC)).
factorize_multNsu(bvsl_bis(N,X,Y,Z),Susp,u,N,A,B,C,KC,UOC,_,Goal,Continue) ?- !,
+ not_unify(C,0),
(X == A ->
number(B),
B is 2^Y
@@ -1973,15 +2010,15 @@ factorize_multN_op_arg_res(A,B,K,UO,Goal,Continue) :-
% Réciproque : si A <> 0, alors B impair (et <> 0)
%
% Si A <> 0 et B <> 1 alors débordement certain car k*Size <> 0
- (((is_odd(A), % A impair et B = -1
+ (((is_odd(int,A), % A impair et B = -1
Var = B,
Val = -1);
- (is_even(B), % B pair et A = 0
+ (is_even(int,B), % B pair et A = 0
Var = A,
Val = 0))
->
% A = 0 ou B = -1 donc pas de débordement
- Goal = (Var = Val, true, UO = 0, true, K = 0)
+ Goal = (protected_unify(Var,Val),protected_unify(UO,0),protected_unify(K,0))
; Continue = 1,
% si A <> 0, alors B impair
% si B <> -1, alors A pair
@@ -2007,9 +2044,9 @@ factorize_multN_op_arg_res(A,B,K,UO,Goal,Continue) :-
%% Ses contraintes peuvent etre "scheduled" et invisibles
%% donc on se protège.
kill_multN(Op,Susp,SU,N,A,B,C,KC) :-
- (kill_multN1(Op,Susp,SU,N,A,B,C,KC) ->
- true
- ; true).
+ (kill_multN1(Op,Susp,SU,N,A,B,C,KC) ->
+ true
+ ; true).
kill_multN1(mult,_,SU,N,A,B,C,KC) :-
%% A*B = C + K*Size
diff --git a/Src/COLIBRI/mreal.pl b/Src/COLIBRI/mreal.pl
index 78f948dd84f9a29da413055687f006f024c501cf..3ef78a7492c9db64ac83f6fea4f71d5dc7427a7c 100755
--- a/Src/COLIBRI/mreal.pl
+++ b/Src/COLIBRI/mreal.pl
@@ -4,59 +4,59 @@
:- begin_module(mreal).
:- export
- set_threshold/1,
- get_threshold/1,
- dom_intersection/4,
- check_dom_intersection/2,
- dom_union/4,
- dom_difference/4,
- dom_interval/2,
- dom_size/2,
- dom_type/2,
- list_to_dom/2,
- list_to_typed_dom/3,
- is_real_domain/1,
- dvar_domain/2,
- dvar_size/2,
- mindomain/2,
- maxdomain/2,
- dvar_range/3,
- dom_range/3,
- dvar_replace/2,
- dvar_set/2, %% dvar_replace + notify
- dvar_update/2, %% dvar_set + INTERSECTION
- dvar_remove_smaller/2,
- dvar_remove_greater/2,
- dvar_remove_element/2,
- remove_interval_smaller/3,
- remove_interval_greater/3,
- in_domain/2,
- in_interval/2,
- finterval_difference/4,
- set_intervals/2, %% avec lecture variable globalle float_eval
- set_typed_intervals/3,
- get_intervals/2,
- init_domain/2,
- copy_domain/2,
- %% Interface + typage
- '::'/2,
- op(700,xfx,'::'),
- real/2,
- float_simple/2,
- float_double/2.
+ set_threshold/1,
+ get_threshold/1,
+ dom_intersection/4,
+ check_dom_intersection/2,
+ dom_union/4,
+ dom_difference/4,
+ dom_interval/2,
+ dom_size/2,
+ dom_type/2,
+ list_to_dom/2,
+ list_to_typed_dom/3,
+ is_real_domain/1,
+ dvar_domain/2,
+ dvar_size/2,
+ mindomain/2,
+ maxdomain/2,
+ dvar_range/3,
+ dom_range/3,
+ dvar_replace/2,
+ dvar_set/2, %% dvar_replace + notify
+ dvar_update/2, %% dvar_set + INTERSECTION
+ dvar_remove_smaller/2,
+ dvar_remove_greater/2,
+ dvar_remove_element/2,
+ remove_interval_smaller/3,
+ remove_interval_greater/3,
+ in_domain/2,
+ in_interval/2,
+ finterval_difference/4,
+ set_intervals/2, %% avec lecture variable globalle float_eval
+ set_typed_intervals/3,
+ get_intervals/2,
+ init_domain/2,
+ copy_domain/2,
+ % Interface + typage
+ '::'/2,
+ op(700,xfx,'::'),
+ real/2,
+ float_simple/2,
+ float_double/2.
:- import
- setarg/3,
- replace_attribute/3
- from sepia_kernel.
+ setarg/3,
+ replace_attribute/3
+ from sepia_kernel.
:- import
- my_notify_constrained/1,
- my_schedule_suspensions/2,
- check_constrained_var/2,
- check_constrained_vars/2,
- schedule_bound/2
- from notify.
+ my_notify_constrained/1,
+ my_schedule_suspensions/2,
+ check_constrained_var/2,
+ check_constrained_vars/2,
+ schedule_bound/2
+ from notify.
:- import
norm_zero/3,
@@ -65,7 +65,7 @@
get_number_of_floats_between/4,
cast_double_to_simple_float/2,
simple_float_to_string/2
- from colibri.
+ from colibri.
%% PMO debut ajout (compil modifiee dans lib)
:- import
@@ -73,7 +73,7 @@
is_not_float_int_number/1,
is_real_box/1,
is_float_number/1
- from rbox.
+ from rbox.
%% PMO fin ajout
:- import
@@ -94,9 +94,15 @@
get_type/2,
notify_touched_linvar/1,
protected_unify/1,
- protected_unify/2
- from colibri.
+ protected_unify/2,
+ sum_intervals_size_congr/4,
+ reduce_congr_bounds_interval_list_real/5,
+ launch_box/1
+ from colibri.
+:- import
+ exists_congr/3
+ from mod.
%----------------------------------------------------------------
@@ -154,7 +160,7 @@ unify_term_mreal(Value, dom(Type,Inter,_), SuspX) :-
; true),
(Value == nan ->
true
- ; number_in_interval(Inter,Value)),
+ ; in_interval(Inter,Value)),
% "unify_suspend" reveille les listes de X
(var(SuspX) ->
true
@@ -183,8 +189,16 @@ unify_mreal_mreal(Y, AttrX, AttrY, SuspX) :-
->
Dom = dom(Type,IntXY0,SXY0),
(is_float_int_number(Y) ->
- keep_integer_bounds(Type,IntXY0,IntXY)
- ; not_integral_interval_bounds(Type,IntXY0,IntXY)),
+ keep_integer_bounds(Type,IntXY0,IntXY1)
+ ; not_integral_interval_bounds(Type,IntXY0,IntXY1)),
+ (exists_congr(Y,R,M) ->
+ reduce_congr_bounds_interval_list_real(IntXY1,R,M,IntXY,Box),
+ (nonvar(Box) ->
+ %call(spy_here)@eclipse,
+ launch_box(Y)
+ ; true)
+ ; IntXY = IntXY1),
+ IntXY \== [],
(IntXY == IntXY0 ->
SXY = SXY0
; % Grosse sur-approximation pour float_int
@@ -242,10 +256,10 @@ check_threshold(Int,Size,OInt,OSize) :-
get_threshold(Threshold),
((Threshold =:= 0.0; % pas de threshold
length(Int) < length(OInt); % perte d'au moins un intervalle
- (number_in_interval(OInt,-0.0), % perte de -0.0
- not number_in_interval(Int,-0.0);
- number_in_interval(OInt,0.0), % perte de 0.0
- not number_in_interval(Int,0.0));
+ (in_interval(OInt,-0.0), % perte de -0.0
+ not in_interval(Int,-0.0);
+ in_interval(OInt,0.0), % perte de 0.0
+ not in_interval(Int,0.0));
interval_range(OInt,OL,OH),
interval_range(Int,L,H),
(OL == -1.0Inf,
@@ -277,7 +291,7 @@ test_unify_mreal(Term, Attr) :-
test_unify_term_mreal(Float, dom(_,Inter,_)) :-
/*** NONVAR + META ***/
once (float(Float), % The metaterm was instantiated, wake all
- number_in_interval(Inter,Float);
+ in_interval(Inter,Float);
Float == nan).
test_unify_term_mreal(Y{mreal:AttrY}, AttrX) :-
-?->
@@ -285,7 +299,7 @@ test_unify_term_mreal(Y{mreal:AttrY}, AttrX) :-
test_unify_mreal_mreal(_, _, AttrY) :-
var(AttrY).
-test_unify_mreal_mreal(Y, dom(Type,IntX,SX), dom(Type1,IntY,SY)) ?-
+test_unify_mreal_mreal(Y, dom(Type,IntX,_SX), dom(Type1,IntY,_SY)) ?-
/*** META + META ***/
(Type = Type1 ->
% on unifie pour les constantes qui ont un type variable
@@ -299,7 +313,11 @@ test_unify_mreal_mreal(Y, dom(Type,IntX,SX), dom(Type1,IntY,SY)) ?-
intervals_intersection(Type,IntX,IntY,IntXY0),
IntXY0 \== [],
(is_float_int_number(Y) ->
- keep_integer_bounds(Type,IntXY0,IntXY)
+ (exists_congr(Y,_R,_M) ->
+ % préparé par test_unify_mod
+ call(getval(check_congr,(IR,IM)))@colibri,
+ reduce_congr_bounds_interval_list_real(IntXY0,IR,IM,IntXY,_Box)
+ ; keep_integer_bounds(Type,IntXY0,IntXY))
; not_integral_interval_bounds(Type,IntXY0,IntXY)),
IntXY \== []
; (is_real_box(Y) ->
@@ -368,9 +386,15 @@ simple_interval_to_string(F,NF) :-
in_domain(dom(_,LInter,_),Atom) ?-
in_interval(LInter,Atom).
+:- import float_of_rat/4 from colibri.
%%:- mode in_interval(++,++).
in_interval(LInter,IV) :-
- number_in_interval(LInter,IV).
+ (rational(IV) ->
+ float_of_rat(float_simple,rtn,IV,LIV),
+ float_of_rat(float_simple,rtp,IV,HIV),
+ number_in_interval(LInter,LIV),
+ number_in_interval(LInter,HIV)
+ ; number_in_interval(LInter,IV)).
%----------------------------------------------------------------
@@ -419,9 +443,9 @@ dom_intersection(dom(Type,Inter1,S1),dom(Type,Inter2,S2),dom(Type,NInter,S),S) :
real_interval_size(Type,NInter,0,S)).
-one_is_contained(Type,LI1,S1,LI1,S2,LI,S) ?- !,
+one_is_contained(_Type,LI1,S1,LI1,S2,LI,S) ?- !,
LI = LI1,
- S1 = S2,
+ S1 = S2,
S = S1.
one_is_contained(Type,LI1,S1,[Min2..Max2],_,LI1,S1) :-
interval_range(LI1,Min1,Max1),
@@ -443,6 +467,7 @@ one_is_contained(Type,[Min1..Max1],_,LI2,S2,LI2,S2) :-
; true).
%%:- mode real_interval_size(++,++,++,-).
+:- export real_interval_size/4.
real_interval_size(_,[],S,S).
real_interval_size(Type,[I|LI],S0,S) :-
real_interval_size1(Type,I,S0,S1),
@@ -452,7 +477,7 @@ real_interval_size(Type,[I|LI],S0,S) :-
real_interval_size1(Type,L..H,S0,S) ?- !,
get_number_of_floats_between(Type,L,H,SI),
S is S0 + SI.
-real_interval_size1(_,F,S0,S) :-
+real_interval_size1(_,_F,S0,S) :-
S is 1 + S0.
keep_interval_between([],_,_,[]).
@@ -730,7 +755,7 @@ set_domain_list([V|Vars],Type,Inter,S,Wake) :-
from colibri.
%% S, la taille de Inter, peut etre non instanciee
-set_var_domain(V{mreal:dom(_,Inter,_)},Type,Inter,_,_) ?- !.
+set_var_domain(V{mreal:dom(_,Inter,_)},_Type,Inter,_,_) ?- !.
set_var_domain(V{mreal:OldDom},Type,Inter,S,Wake) ?- !,
(compound(OldDom) ->
(get_sign(V,OSV) ->
@@ -775,10 +800,10 @@ set_var_domain(V,Type,Inter,S,Wake) :-
Wake = 1.
-init_var_domain(V,Type,Inter,_) :-
+init_var_domain(V,_Type,Inter,_) :-
nonvar(V),!,
- number_in_interval(Inter,V).
-init_var_domain(V,Type,Inter0,S0) :-
+ in_interval(Inter,V).
+init_var_domain(V,Type,Inter0,_S0) :-
(is_float_int_number(V) ->
keep_integer_bounds(Type,Inter0,Inter),
real_interval_size(Type,Inter,0,S)
@@ -798,11 +823,11 @@ init_var_domain(V,Type,Inter0,S0) :-
protected_unify(V = V0)
; add_attribute(V,dom(Type,Inter,S),mreal)).
-get_intervals(V{mreal:dom(Type,LInter,_)},NLInter) ?- !,
- NLInter = LInter.
+get_intervals(_V{mreal:dom(_Type,LInter,_)},NLInter) ?- !,
+ NLInter = LInter.
get_intervals(V,LInter) :-
- nonvar(V),
- LInter = [V].
+ nonvar(V),
+ LInter = [V].
%% Pour compatibilite
@@ -810,7 +835,7 @@ set_intervals(V,LInter) :-
getval(float_eval,Type)@eclipse,
set_typed_intervals(V,Type,LInter).
-set_typed_intervals(V{mreal:dom(Type,OldLInter,_)},Type,OldLInter) ?- !.
+set_typed_intervals(_V{mreal:dom(Type,OldLInter,_)},Type,OldLInter) ?- !.
set_typed_intervals(V,Type,LInter) :-
list_to_intervals(Type,LInter,NLInter),
check_constrained_var(V,Constrained),
@@ -843,7 +868,7 @@ dvar_domain(Val,Dom) :-
%----------------------------------------------------------------
% dvar_size(Var,Size)
%----------------------------------------------------------------
-dvar_size(_{mreal:dom(_,Interval,S)},Size) ?- !,
+dvar_size(_{mreal:dom(_,_Interval,S)},Size) ?- !,
Size = S.
dvar_size(Val,Size) :-
float(Val),
@@ -903,7 +928,7 @@ dvar_replace(Var{mreal:dom(Type,_,_)},dom(Type,Inter,S)) ?-
; set_dom(Var,Type,Inter1,S1)).
dvar_replace(Real,dom(_,Inter1,_)) :-
number(Real),
- number_in_interval(Inter1,Real).
+ in_interval(Inter1,Real).
reduce_float_int(Var,Type,Inter,S,Inter1,S1) :-
(is_float_int_number(Var) ->
@@ -917,10 +942,18 @@ reduce_float_int(Var,Type,Inter,S,Inter1,S1) :-
%%:- mode set_dom(?,++,++,++).
:- export set_dom/4.
-set_dom(Var{mreal:Dom},Type,Inter,S) :- -?->
- setarg(1,Dom,Type),
- setarg(2,Dom,Inter),
- setarg(3,Dom,S).
+set_dom(Var{mreal:Dom},Type,Inter,S) ?-
+ (exists_congr(Var,R,M) ->
+ reduce_congr_bounds_interval_list_real(Inter,R,M,NInter,Box)
+ ; NInter = Inter),
+ Inter \== [],
+ (nonvar(Box) ->
+ %call(spy_here)@eclipse,
+ launch_box(Var)
+ ; true),
+ setarg(1,Dom,Type),
+ setarg(2,Dom,Inter),
+ setarg(3,Dom,S).
%----------------------------------------------------------------
% dvar_set(Var,+Dom) PAS D'INTERSECTION
@@ -954,15 +987,15 @@ dvar_set(Var{mreal:dom(Type,Inter0,S0)},dom(Type,Inter,S)) ?- !,
; true)).
dvar_set(Real,dom(_,Inter1,_)) :-
number(Real),
- number_in_interval(Inter1,Real).
+ in_interval(Inter1,Real).
%----------------------------------------------------------------
% dvar_update(Var,+Dom)
% Idem dvar_set + INTERSECTION
%----------------------------------------------------------------
%%:- mode dvar_update(?,++).
-dvar_update(Var{mreal:Dom},Dom) ?- !.
-dvar_update(Var{mreal:dom(Type,Inter0,S)},dom(Type,Inter1,S1)) ?- !,
+dvar_update(_Var{mreal:Dom},Dom) ?- !.
+dvar_update(Var{mreal:dom(Type,_Inter0,_S)},dom(Type,Inter1,S1)) ?- !,
Inter1 \== [],
((Inter1 = [Val],
float(Val)) ->
@@ -979,89 +1012,89 @@ dvar_update(Var{mreal:dom(Type,Inter0,S)},dom(Type,Inter1,S1)) ?- !,
; true)).
dvar_update(Real,dom(_,Inter1,_)) :-
number(Real),
- number_in_interval(Inter1,Real).
+ in_interval(Inter1,Real).
%----------------------------------------------------------------
% dvar_remove_smaller(Var,+Elt)
%----------------------------------------------------------------
%:- mode dvar_remove_smaller(?,++).
-dvar_remove_smaller(Var{mreal:dom(Type,Inter,S)},IBound) ?- !,
- float(IBound),
- norm_zero(Type,IBound,Bound),
+dvar_remove_smaller(Var{mreal:dom(Type,Inter,_S)},IBound) ?- !,
+ float(IBound),
+ norm_zero(Type,IBound,Bound),
interval_range(Inter,MinV,MaxV),
- compare(OMin,Bound,MinV),
+ compare(OMin,Bound,MinV),
((OMin == < ; OMin == =) ->
- true
- ; compare(OMax,Bound,MaxV),
+ true
+ ; compare(OMax,Bound,MaxV),
(OMax == = ->
- (Type == real ->
+ (Type == real ->
abs(MaxV) =\= 1.0Inf
; true),
protected_unify(Var = MaxV)
- ; OMax == <,
+ ; OMax == <,
keep_interval_between(Inter,Bound,MaxV,NInter),
- real_interval_size(Type,NInter,0,NS),
- dvar_set(Var,dom(Type,NInter,NS)))).
+ real_interval_size(Type,NInter,0,NS),
+ dvar_set(Var,dom(Type,NInter,NS)))).
dvar_remove_smaller(Var,Val) :-
- float(Var),
- float(Val),
- Val =< Var.
+ float(Var),
+ float(Val),
+ Val =< Var.
remove_interval_smaller(Inter,Bound,NInter) :-
- interval_range(Inter,Min,Max),
- (Max =:= Bound ->
- NInter = [Max]
- ; (Max > Bound ->
- (Min < Bound ->
- keep_interval_between(Inter,Bound,Max,NInter)
- ; NInter = Inter)
- ; NInter = [])).
+ interval_range(Inter,Min,Max),
+ (Max =:= Bound ->
+ NInter = [Max]
+ ; (Max > Bound ->
+ (Min < Bound ->
+ keep_interval_between(Inter,Bound,Max,NInter)
+ ; NInter = Inter)
+ ; NInter = [])).
%----------------------------------------------------------------
% dvar_remove_greater(Var,+Elt)
%----------------------------------------------------------------
%:- mode dvar_remove_greater(?,++).
-dvar_remove_greater(Var{mreal:dom(Type,Inter,S)},IBound) ?- !,
- float(IBound),
- norm_zero(Type,IBound,Bound),
+dvar_remove_greater(Var{mreal:dom(Type,Inter,_S)},IBound) ?- !,
+ float(IBound),
+ norm_zero(Type,IBound,Bound),
interval_range(Inter,MinV,MaxV),
- compare(OMax,MaxV,Bound),
+ compare(OMax,MaxV,Bound),
((OMax == <; OMax == =) ->
- true
- ; compare(OMin,Bound,MinV),
+ true
+ ; compare(OMin,Bound,MinV),
(OMin == = ->
- (Type == real ->
+ (Type == real ->
abs(MinV) =\= 1.0Inf
; true),
protected_unify(Var = MinV)
- ; OMin == >,
- keep_interval_between(Inter,MinV,Bound,NInter),
- real_interval_size(Type,NInter,0,NS),
- dvar_set(Var,dom(Type,NInter,NS)))).
+ ; OMin == >,
+ keep_interval_between(Inter,MinV,Bound,NInter),
+ real_interval_size(Type,NInter,0,NS),
+ dvar_set(Var,dom(Type,NInter,NS)))).
dvar_remove_greater(Var,Val) :-
- float(Var),
- float(Val),
- Val >= Var.
+ float(Var),
+ float(Val),
+ Val >= Var.
remove_interval_greater(Inter,Bound,NInter) :-
- interval_range(Inter,Min,Max),
- (Max =< Bound ->
- NInter = Inter
- ; (Min =:= Bound ->
- NInter = [Min]
- ; (Min < Bound ->
- %% Min < Bound < Max
- keep_interval_between(Inter,Min,Bound,NInter)
- ; NInter = []))).
+ interval_range(Inter,Min,Max),
+ (Max =< Bound ->
+ NInter = Inter
+ ; (Min =:= Bound ->
+ NInter = [Min]
+ ; (Min < Bound ->
+ % Min < Bound < Max
+ keep_interval_between(Inter,Min,Bound,NInter)
+ ; NInter = []))).
%----------------------------------------------------------------
% dvar_remove_element(Var,+Elt)
%----------------------------------------------------------------
%%:- mode dvar_remove_element(?,++).
-dvar_remove_element(Var{mreal:dom(Type,Inter,OS)},Number) ?- !,
+dvar_remove_element(Var{mreal:dom(Type,Inter,_OS)},Number) ?- !,
float(Number),
((Type == real,
is_float_number(Var))
diff --git a/Src/COLIBRI/ndelta.pl b/Src/COLIBRI/ndelta.pl
index 6817c254a2c7790baff5a12b50042aa6d5550155..fa39e12941b5ceb4aab51f6ff93eb34931133f8d 100755
--- a/Src/COLIBRI/ndelta.pl
+++ b/Src/COLIBRI/ndelta.pl
@@ -241,7 +241,9 @@ add(X, Y, Z), lt(C, Z), add(Y,T,D), add(X, D, C), show_deltas_vars.
two_value_domain/2,
protected_unify/2,
not_zero/1,
- lin_unify/2
+ lin_unify/2,
+ protected_numerator/2,
+ protected_denominator/2
from colibri.
@@ -358,7 +360,7 @@ pre_unify_delta_var(V1,T2) :-
lin_unify(V1,T2).
%% On doit modifier le graphe des deltas dans unify_delta
-pre_unify_delta_var_nonvar(Var{ndelta:delta(Before,After,Loop,CC)},Val) ?-
+pre_unify_delta_var_nonvar(Var{ndelta:delta(Before,After,Loop,CC)},_Val) ?-
% Ne pas utiliser de call_priority car
% il provoquerait un wake alors qu'on n'a pas fini l'unification
get_priority(Prio),
@@ -435,7 +437,7 @@ test_unify_term_delta(Y{ndelta:AttrY}, AttrX) :-
test_unify_delta_delta(_, _, AttrY) :-
var(AttrY).
-test_unify_delta_delta(Y, delta(BeforeX,AfterX,Loop,CC), DeltasY) ?-
+test_unify_delta_delta(Y, delta(BeforeX,AfterX,_Loop,_CC), _DeltasY) ?-
/*** META + META ***/
% Test partiel, si on a un delta entre X et Y
% il doit accepter 0 pour Cost
@@ -465,15 +467,15 @@ print_delta(_{ndelta:delta(Before,After,Loop,CC)}, Attribute) ?-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-deltas_number(X{ndelta:delta(B,A,_Loop,_CC)},Nb) ?- !,
+deltas_number(_X{ndelta:delta(B,A,_Loop,_CC)},Nb) ?- !,
Nb is length(B) + length(A).
deltas_number(_,0).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-is_delta_var(X{ndelta:delta(B,A,_Loop,_CC)}) ?-
+is_delta_var(_X{ndelta:delta(B,A,_Loop,_CC)}) ?-
(B,A) \== ([],[]).
-is_signed_delta_var(X{ndelta:delta(B,A,_Loop,_CC)}) ?-
+is_signed_delta_var(_X{ndelta:delta(B,A,_Loop,_CC)}) ?-
(member((_,S,C),B);
member((_,S,C),A)),
S \== '#',
@@ -487,7 +489,7 @@ is_signed_delta_var(X{ndelta:delta(B,A,_Loop,_CC)}) ?-
%% On recupere les deux deltas entre X et Y
%% et C est de la forme B1..B2 pour S = '+'|'#'
%% (B1 peut etre plus grand que B2) ??
-get_deltas(X{ndelta:delta(BX,AfterX,(ILX,_),CC1)},Y{ndelta:delta(BY,AfterY,(ILY,_),CC2)},NS,NC) ?-
+get_deltas(X{ndelta:delta(BX,AfterX,(_ILX,_),CC1)},Y{ndelta:delta(BY,AfterY,(_ILY,_),CC2)},NS,NC) ?-
getval(use_delta,1)@eclipse,
(match_delta_var(AfterX,Y,S,C) ->
true
@@ -508,7 +510,7 @@ get_deltas(X{ndelta:delta(BX,AfterX,(ILX,_),CC1)},Y{ndelta:delta(BY,AfterY,(ILY,
CC1 = CC2
; true).
-match_delta_var([(Var,R,C)|Deltas],Var,Rel,Cost) ?- !,
+match_delta_var([(Var,R,C)|_Deltas],Var,Rel,Cost) ?- !,
Rel = R,
get_type(Var,Type),
(Type == int ->
@@ -524,24 +526,24 @@ match_delta_var([_|Deltas],Var,Rel,Cost) :-
lrnd_integer(V,NV) :-
RV is rational(V),
- (denominator(RV) =:= 1 ->
- NV is numerator(RV)
+ (protected_denominator(RV) =:= 1 ->
+ NV is protected_numerator(RV)
; NV is integer(floor(RV))).
hrnd_integer(V,NV) :-
RV is rational(V),
- (denominator(RV) =:= 1 ->
- NV is numerator(RV)
+ (protected_denominator(RV) =:= 1 ->
+ NV is protected_numerator(RV)
; NV is integer(ceiling(RV))).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% X contient un delta a partir de X
-exists_delta_start(X{ndelta:delta(_,[_|_AfterX],_Loop,_CC)}) ?-
+exists_delta_start(_X{ndelta:delta(_,[_|_AfterX],_Loop,_CC)}) ?-
true.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% X contient un delta aboutisant a X
-exists_delta_end(X{ndelta:delta([_|_BeforeX],_,_,_CC)}) ?-
+exists_delta_end(_X{ndelta:delta([_|_BeforeX],_,_,_CC)}) ?-
true.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -614,7 +616,7 @@ replace_Val_by_NewVar(BA,[(Var,_,_)|L],Val,NewVar) :-
replace_Val_by_NewVar_in_Var(BA,Var,Val,NewVar),
replace_Val_by_NewVar(BA,L,Val,NewVar).
-replace_Val_by_NewVar_in_Var(BA,Var{ndelta:Deltas},Val,NewVar) ?-
+replace_Val_by_NewVar_in_Var(BA,_Var{ndelta:Deltas},Val,NewVar) ?-
compound(Deltas),!,
arg(BA,Deltas,LD),
once (member_begin_end((V,S,C),LD,NLD,ENLD,End),
@@ -626,7 +628,7 @@ replace_Val_by_NewVar_in_Var(BA,Var{ndelta:Deltas},Val,NewVar) ?-
-join_before_after1(Before,After,VarVal,(Loop,_),CC) :-
+join_before_after1(Before,After,VarVal,(_Loop,_),_CC) :-
% VarVal va etre instanciee
% Si on instancie au milieu d'une chaine
% sans modifier CC de parts et d'autres
@@ -703,7 +705,7 @@ change_CC([V|Vars],Seen) :-
% Deja vu
Seen1 = Seen
; % Nouveau et meme CC pour tous les sommets connexes
- change_CC_var(V,CC,[],Seen,Seen1)),
+ change_CC_var(V,_CC,[],Seen,Seen1)),
change_CC(Vars,Seen1).
%% Traitement des variables atteignables
@@ -745,7 +747,7 @@ change_CCV([(V,_,_)|Vars],CC,Ancestors,Seen,NSeen) :-
change_CCV(Vars,CC,Ancestors,Seen1,NSeen).
set_loop_in_ancestors(L,V) :-
- member_begin_end(VV,L,Beg,PEnd,End),
+ member_begin_end(VV,L,Beg,PEnd,_End),
VV == V,!,
PEnd = [],
(Beg = [_,_|_] ->
@@ -867,7 +869,7 @@ build_deltas_from_after([(X,S,C)|After],Var,NewDeltas) :-
build_deltas_from_after(After,Var,EndNewDeltas).
%% On enleve (Var,S,C) des after de X
-remove_delta_in_after(X{ndelta:DX},Var,S,C) ?-
+remove_delta_in_after(_X{ndelta:DX},Var,S,C) ?-
compound(DX),
arg(2,DX,AX),
remove_var_from_deltas(AX,Var,S,C,NAX),
@@ -882,7 +884,7 @@ remove_var_from_deltas([(V,S,C)|Deltas],Var,VS,VC,NewDeltas) :-
%% remove_var_from_deltas([],_,_,_,[]).
%% On enleve (Var,S,C) des before de X
-remove_delta_in_before(X{ndelta:DX},Var,S,C) ?-
+remove_delta_in_before(_X{ndelta:DX},Var,S,C) ?-
compound(DX),
arg(1,DX,BX),
remove_var_from_deltas(BX,Var,S,C,NBX),
@@ -1165,7 +1167,7 @@ insert_EqPaths([(V1,TC1)|EqPaths],V,TC,NEqPaths) :-
NEqPaths = [(V1,TC1)|EqPaths],
((V1 \== V,
get_type(V1,T1),
- get_type(V,T),
+ get_type(V,T2),
T1 == T2)
->
unify_later(V,V1)
@@ -1230,7 +1232,7 @@ launch_delta_bis1(X,Y,S,C) :-
:- mode launch_delta_bis2(?,?,++,++,?,?,?).
% on ignore les distances nulles (pbs sinon)
%launch_delta_bis2(X,Y,S,0,CheckCycle,LoopOnly,Abort) ?- !.
-launch_delta_bis2(X,Y,S0,C,CheckCycle,LoopOnly,Abort) :-
+launch_delta_bis2(X,Y,S0,C,CheckCycle,_LoopOnly,Abort) :-
getval(use_delta,1)@eclipse,
!,
(number(C) ->
@@ -1286,17 +1288,17 @@ launch_delta_bis2(_,_,_,_,_,_,_).
:- export check_inside_delta_loop/2.
check_inside_delta_loop(Loop,_) :-
var(Loop),!.
-check_inside_delta_loop(_,Var{ndelta:delta(_,_,(IL,_),_CC)}) ?-
+check_inside_delta_loop(_,_Var{ndelta:delta(_,_,(IL,_),_CC)}) ?-
nonvar(IL).
-get_loop_ids(V{ndelta:delta(_,_,Loop,_)},LoopIds) ?-
+get_loop_ids(_V{ndelta:delta(_,_,Loop,_)},LoopIds) ?-
LoopIds = Loop.
-same_CC(X{ndelta:delta(_,_,_,CC)},Y{ndelta:delta(_,_,_,CC)}) ?-
+same_CC(_X{ndelta:delta(_,_,_,CC)},_Y{ndelta:delta(_,_,_,CC)}) ?-
getval(use_delta,1)@eclipse.
@@ -1334,11 +1336,11 @@ protected_rat_diff(A,B,C) :-
deltas_inter(S,C,S,C,NS,NC,_) ?- !,
NS = S,
NC = C.
-deltas_inter(#,OC,S,C,NS,NC,Check) :-
+deltas_inter(#,OC,S,C,NS,NC,Check) ?- !,
deltas_inter_diff(OC,S,C,NS,NC,Check).
-deltas_inter(+,OC,S,C,NS,NC,Check) :-
+deltas_inter(+,OC,S,C,NS,NC,Check) ?- !,
deltas_inter_plus(OC,S,C,NS,NC,Check).
-deltas_inter(=,OC,S,C,NS,NC,_Check) :-
+deltas_inter(=,OC,S,C,NS,NC,_Check) ?- !,
deltas_inter_eg(OC,S,C,NS,NC).
deltas_inter_diff(OMin..OMax,=,C,=,C,1) :- !,
@@ -1442,7 +1444,7 @@ update_deltas(X,Y,S0,C0) :-
% Si on durcit la relation d'un delta
% on schedule les contraintes communes a X et Y pour
% qu'elles puissent exploiter le nouveau delta
- (exists_delta_Rel(X,Y,ORel,OS,OC) ->
+ (exists_delta_Rel(X,Y,ORel,_OS,_OC) ->
true
; true),
update_delta_cost_with_congr(X,Y,S0,C0,S,C),
@@ -1458,7 +1460,7 @@ update_deltas(X,Y,S0,C0) :-
check_equal_paths(Y)
; true),
((% peut provoquer des convergences lentes!!!
- exists_delta_Rel(X,Y,NRel,NS,NC),
+ exists_delta_Rel(X,Y,NRel,_NS,_NC),
NRel \== ORel)
->
% On a change la relation, on previent
@@ -1502,13 +1504,13 @@ update_deltas_between(X,Y,NS,NC) :-
set_before_after(Y,[(X,NS,NC)|NBY],NAY),
check_exists_regular_delta(X,Y,NS,NC).
-set_before_after(V{ndelta:Delta},Before,After) ?-
+set_before_after(_V{ndelta:Delta},Before,After) ?-
compound(Delta),
setarg(1,Delta,Before),
setarg(2,Delta,After).
%% On inhibe check_exists_regular_delta
-check_exists_regular_delta(X,Y,S,C) :- !.
+check_exists_regular_delta(_X,_Y,_S,_C) :- !.
check_exists_regular_delta(X,Y,S,C) :-
get_delta_before_after(X,_,AfterX),
get_delta_before_after(Y,BeforeY,_),
@@ -1531,7 +1533,7 @@ check_exists_regular_delta(X,Y,S,C) :-
%%check_delta_cycle(X,Y,LoopOnly) :- !.
check_delta_cycle(X,Y,LoopOnly) :-
% Pas de check a partir d'un # !!
- ((get_deltas(X,Y,S,Cost),
+ ((get_deltas(X,Y,_S,_Cost),
connected_to_other_vars(X,Y))
->
@@ -1624,7 +1626,7 @@ check_delta_join0(X,Y,Loop) :-
set_seen_delta(Y),
setval(delta_credit,100),
%incval(nb_steps)@eclipse,
- block(check_previous_deltas(Loop,Vars,Last,[Y],X,Y,NewLoop),
+ block(check_previous_deltas(Loop,Vars,Last,[Y],X,Y,_NewLoop),
Tag,
(Tag == check_delta_join ->
(getval(gdbg,1)@eclipse ->
@@ -1730,14 +1732,14 @@ not_seen_inside_delta_loop(Loop,X) :-
fail.
clean_seen_delta([]).
-clean_seen_delta([X{ndelta:Delta}|Vars]) ?-
+clean_seen_delta([_X{ndelta:Delta}|Vars]) ?-
arg(3,Delta,(L,_)),
setarg(3,Delta,(L,_)),
clean_seen_delta(Vars).
-check_previous_deltas(Loop,[(Start,End)|Vars],Last,Done,InJoin,Join,NewLoop) ?- !,
+check_previous_deltas(Loop,[(Start,_End)|Vars],Last,Done,InJoin,Join,NewLoop) ?- !,
getval(delta_credit,Credit),
((seen_delta(Start);
Credit == 0)
@@ -1745,7 +1747,7 @@ check_previous_deltas(Loop,[(Start,End)|Vars],Last,Done,InJoin,Join,NewLoop) ?-
(Credit == 0 ->
clean_seen_delta(Done)
; % On a deja traite les previous de Start
- check_previous_deltas(Loop,Vars,Last,Done,InJoin,Join,Stop))
+ check_previous_deltas(Loop,Vars,Last,Done,InJoin,Join,_Stop))
; % Done contient End et tout ceux dont on a deja calcule
% les Previous
delta_previous(Start,Loop,Previous,NewVars,NewLast),
@@ -1842,7 +1844,7 @@ spy_delta.
-add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,InJoin,Join) :-
+add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,_InJoin,Join) :-
% On regarde les transitivites Start -> End -> Join
% en recollant un arc transitif End -> Join derriere le nouvel arc Start -> End
EndTransPath = trans_path{
@@ -1858,7 +1860,7 @@ add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,InJoin,Join) :-
NTNb = Nbp
; NTNb is Nbp + 1),
% On regarde si on ferme un cycle
- (find_delta_join(Start,TransPath,SuspStart) ->
+ (find_delta_join(Start,TransPath,_SuspStart) ->
NewLoop = 1,
% (Start,Join,OTS,OTC,OTOpC) existe deja
% DONC ON A UN CYLE PASSANT PAR Start ET Join
@@ -1897,7 +1899,7 @@ add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,InJoin,Join) :-
change_plus_to_equal_in_paths(TMaxPaths,Join)
; % Si un des chemins est un = et que l'autre ne contient qu'un
% seul + alors on peut transformer ce + en = en ajustant son cout
- update_equal_paths(NTSp,Join,TNb,Start,NTCp,TMaxPaths,UpdateEqPaths),
+ update_equal_paths(NTSp,Join,TNb,Start,NTCp,TMaxPaths,_UpdateEqPaths),
((NTSp == '+',
TS == '=',
NTNb == 1)
@@ -1940,7 +1942,7 @@ add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,InJoin,Join) :-
%NCp is NOpC + NNTC,
%NOpCp is NC + NNTOpC,
try_replace_by_equal_or_update_delta(
- End,Join,Sp,Cp,OpCp,NSp,NCp,NOpCp,_,RC,ROpC)
+ End,Join,Sp,Cp,OpCp,NSp,NCp,NOpCp,_,_RC,_ROpC)
; true)))),
% Start-*-Join ne va plus servir autrement que dans le role de End-*-Join
% dans un prochain add_new_previous, seuls les MaxPaths et EqPaths
@@ -2002,7 +2004,7 @@ add_new_previous(Loop,Start,End,S,C,OpC,EndTransPath,NewLoop,InJoin,Join) :-
suspend(delta_join(NewTransPath),1,[Start->suspend:inst,trigger(delta_join)])).
-extend_paths(Start,[],[]) :- !.
+extend_paths(_Start,[],[]) :- !.
extend_paths(Start,Paths,[(Start,Paths)]).
@@ -2049,7 +2051,7 @@ merge_path_trees([(Root,SubTrees)|Trees],Trees1,Res) :-
%%try_replace_by_equal_or_update_delta(Start,End,S,C,OpC,Sp1,Cp1,OpCp1,S,C,OpC) :- !.
-try_replace_by_equal_or_update_delta(Start,End,S,C,OpC,Sp1,Cp1,OpCp1,NewS,NewC,NewOpC) :-
+try_replace_by_equal_or_update_delta(Start,End,_S,C,OpC,_Sp1,Cp1,OpCp1,NewS,NewC,NewOpC) :-
get_deltas(Start,End,OldS,OldCost),
min_max_inter(OldCost,OldC,MOldOpC),
OldOpC is -MOldOpC,
@@ -2092,17 +2094,17 @@ try_replace_by_equal_or_update_delta(Start,End,S,C,OpC,Sp1,Cp1,OpCp1,NewS,NewC,N
%% C est le bout du prefixe commun depuis Join
%% et on garde le cycle Start,A,B,C,Y,X,Start
-notify_vars_from_disjoint_paths_pairs(EPaths1,MPaths1,OPaths1,EPaths2,MPaths2,OPaths2,Join) :- !.
+notify_vars_from_disjoint_paths_pairs(_EPaths1,_MPaths1,_OPaths1,_EPaths2,_MPaths2,_OPaths2,_Join) :- !.
%% Si on est confine dans des boucles, tout le monde est deja notifie.
-notify_vars_from_disjoint_paths_pairs(Loop,EPaths1,MPaths1,OPaths1,EPaths2,MPaths2,OPaths2,Join) :-
+notify_vars_from_disjoint_paths_pairs(Loop,_EPaths1,_MPaths1,_OPaths1,_EPaths2,_MPaths2,_OPaths2,_Join) :-
nonvar(Loop),!.
notify_vars_from_disjoint_paths_pairs(_,EPaths1,MPaths1,OPaths1,EPaths2,MPaths2,OPaths2,Join) :-
term_variables((EPaths1,MPaths1,OPaths1,EPaths2,MPaths2,OPaths2,Join),Vars),
set_loop_id(Vars).
set_loop_id([]).
-set_loop_id([V{ndelta:Deltas}|LV]) ?-
+set_loop_id([_V{ndelta:Deltas}|LV]) ?-
(compound(Deltas) ->
arg(3,Deltas,(1,_))
; getval(gdbg,1)@eclipse,
@@ -2235,7 +2237,7 @@ change_plus_and_adjust_to_equal_in_subtrees(X,[(Y,Subtrees)|Trees],Cost,Join) :-
protected_rat_diff(Cost,C,NewCost),
%NewCost is Cost - C,
change_plus_and_adjust_to_equal([(Y,Subtrees)],NewCost,Join)
- ; get_all_paths_starting_with_End(Y,trans_path{sort:Sp,cost:Cp,nbplus:Nbp}),
+ ; get_all_paths_starting_with_End(Y,trans_path{sort:_Sp,cost:Cp,nbplus:Nbp}),
(Nbp == 0 ->
% On n'a plus de '+' dans (Y,Subtrees)
protected_rat_diff(Cost,Cp,NC),
@@ -2268,7 +2270,7 @@ try_replace_delta_plus_by_equal(A,B,C) :-
%% On cherche un "delta" entre X et Y
%% en relation par "Rel"
:- mode exists_delta_Rel(?,?,-,-,-).
-exists_delta_Rel(X{ndelta:delta(BeforeX,AfterX,_,CCX)},Y{ndelta:DeltasY},Rel,S,C) ?-
+exists_delta_Rel(X{ndelta:delta(_BeforeX,_AfterX,_,_CCX)},Y{ndelta:_DeltasY},Rel,S,C) ?-
get_deltas(X,Y,S,C),
get_rel_from_SC(S,C,Rel).
@@ -2300,7 +2302,7 @@ get_rel_from_SC('+',L..H,Rel) :-
%delta_path(K,A,B,Rel,Cost,OpCost,_Seen) :- !,fail.
delta_path(K,A,B,Rel,Cost,OpCost,_Seen) :-
getval(use_delta,1)@eclipse,
- find_deltas_leading_to(K,0,0,B,Deltas,EndDeltas,[B],A,_Found,NFound,StopEqual),
+ find_deltas_leading_to(K,0,0,B,Deltas,EndDeltas,[B],A,_Found,NFound,StopEq),
(nonvar(StopEq) ->
NFound = (Cost,OpCost),
Rel = '='
@@ -2313,7 +2315,7 @@ delta_path(K,A,B,Rel,Cost,OpCost,_Seen) :-
; Rel = '+')).
- find_deltas_leading_to(K0,TC,TOpC,End,Deltas,EndDeltas,Seen,Start,Found,NewFound,StopEqual) :-
+find_deltas_leading_to(K0,TC,TOpC,End,Deltas,EndDeltas,Seen,Start,Found,NewFound,StopEqual) :-
(K0 == 0 ->
Deltas = EndDeltas,
NewFound = Found
@@ -2407,7 +2409,7 @@ delta_path_from_edges(Source,[(K,X,TC,TOpC,Seen)|Edges],EndEdges,Found,NewFound)
(nonvar(StopEqual) ->
NewFound = Found1
; delta_path_from_edges(Source,Edges,NEndEdges,Found1,NewFound)).
- delta_path_from_edges(Source,_,_,Found,Found).
+delta_path_from_edges(_Source,_,_,Found,Found).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Pour voir les deltas d'une liste de variables
@@ -2419,7 +2421,7 @@ show_deltas_vars :-
show_deltas_vars([],_) :- !.
show_deltas_vars(LV,LoopOnly) :-
get_deltas_vars(LV,LoopOnly,Deltas),
- (Deltas = [(X,_,_,_)|_] ->
+ (Deltas = [(_X,_,_,_)|_] ->
PSFile = "/tmp/delta.ps",
DotFile = "/tmp/delta.dot",
concat_string(["dot -Tps ",DotFile," -o ",PSFile],Command1),
@@ -2450,8 +2452,7 @@ get_cast_links0([V|L],Deltas,Casts) :-
(occurs(FType,(real,float_simple,float_double)) ->
suspensions(V,LSusp),
(foreach(Susp,LSusp),
- fromto(End,I,O,Casts),
- param(V) do
+ fromto(End,I,O,Casts) do
get_suspension_data(Susp,goal,G),
(G = cast_real_int1(Type,R,Int) ->
short_type_name(Type,SType),
@@ -2528,9 +2529,9 @@ pp_delta_dot([(X0,Y0,S,C0)|Deltas],Stream) :-
int_from_integral_rat(A,B) :-
((rational(A),
- denominator(A,1))
+ protected_denominator(A,1))
->
- numerator(A,B)
+ protected_numerator(A,B)
; B = A).
write_loop_ids(Stream,[I1,I2|LI]) :- !,
diff --git a/Src/COLIBRI/notify.pl b/Src/COLIBRI/notify.pl
index f3994a99c2871f2f012d63667437c3cc80a80544..72d457b023d9b6f72ea7471407ec70d699896eec 100755
--- a/Src/COLIBRI/notify.pl
+++ b/Src/COLIBRI/notify.pl
@@ -95,9 +95,9 @@ build_notify_handler_calls([Mod:FPred|Handlers],Var,NotifyCalls) :-
%% Par defaut, on fait seulement un schedule_suspensions
-my_schedule_suspensions(Var,Susp) :-
- % Susp est la liste de toutes les suspensions de Var
- schedule_suspensions(1,s(Susp)).
+my_schedule_suspensions(_Var,Susp) :-
+ % Susp est la liste de toutes les suspensions de Var
+ schedule_suspensions(1,s(Susp)).
:- (current_array(schedule_handlers,_) ->
@@ -162,7 +162,7 @@ check_and_clean_constrained_list([Susp|LS],NLS,Constrained,Clean) :-
; Constrained = 1,
NLS = [Susp|LS]).
-set_constrained_attr(V{suspend:Suspend},CstrL) ?-
+set_constrained_attr(_V{suspend:Suspend},CstrL) ?-
setarg(constrained of suspend,Suspend,CstrL).
wake_if_constrained(Constrained) :-
@@ -311,22 +311,22 @@ schedule_bound(SuspX,Y):-
:- mode sleeping_suspensions_sharing_other_vars(++,++,++,++,?,-).
-sleeping_suspensions_sharing_other_vars(CstrX,BoundX,CstrY,BoundY,Y,L) :-
- sleeping_suspensions_and_vars(CstrX,BoundX,PLX,[],VX,CstrX1,BoundX1),
- (VX == [] ->
- L = []
- ; sleeping_suspensions_and_vars(CstrY,BoundY,PLY,[],VY,CstrY1,BoundY1),
- common_items(VY,VX,CV),
-%% A priori Y est toujours dans VX et dans VY et il semble inutile
-%% de reveiller les contraintes concernees si elles ne partagent pas
-%% d'autre variable. En fait il se peut qu'une factorisation devienne
-%% applicable (deux contraintes similaires partageant Y et une constante)
-%% mais ca peut faire plein de reveils inutiles si pas de factoristion
- (CV == [] ->
- L = []
- ; sort(CV,NCV),
- sleeping_suspensions_sharing_vars(NCV,PLX,[],L1,LX),
- sleeping_suspensions_sharing_vars(NCV,PLY,L1,L,LY))).
+sleeping_suspensions_sharing_other_vars(CstrX,BoundX,CstrY,BoundY,_Y,L) :-
+ sleeping_suspensions_and_vars(CstrX,BoundX,PLX,[],VX,_CstrX1,_BoundX1),
+ (VX == [] ->
+ L = []
+ ; sleeping_suspensions_and_vars(CstrY,BoundY,PLY,[],VY,_CstrY1,_BoundY1),
+ common_items(VY,VX,CV),
+ % A priori Y est toujours dans VX et dans VY et il semble inutile
+ % de reveiller les contraintes concernees si elles ne partagent pas
+ % d'autre variable. En fait il se peut qu'une factorisation devienne
+ % applicable (deux contraintes similaires partageant Y et une constante)
+ % mais ca peut faire plein de reveils inutiles si pas de factoristion
+ (CV == [] ->
+ L = []
+ ; sort(CV,NCV),
+ sleeping_suspensions_sharing_vars(NCV,PLX,[],L1,_LX),
+ sleeping_suspensions_sharing_vars(NCV,PLY,L1,L,_LY))).
:- mode sleeping_suspensions_and_vars(++,++,-,+,-,-,-).
sleeping_suspensions_and_vars([],LS1,PLS,AV,SV,[],NLS1) :-
diff --git a/Src/COLIBRI/rbox.pl b/Src/COLIBRI/rbox.pl
index 7a616ce74446dd523e0ebff5c98b78b408fa9442..ce869e5adbc3d0e70baf9b171c0a8a48f24df027 100755
--- a/Src/COLIBRI/rbox.pl
+++ b/Src/COLIBRI/rbox.pl
@@ -49,7 +49,9 @@
get_next_float/3,
get_previous_float/3,
get_type/2,
- is_inside_mantissa/2
+ is_inside_mantissa/2,
+ protected_numerator/2,
+ protected_denominator/2
from colibri.
%----------------------------------------------------------------
@@ -151,8 +153,8 @@ unify_rbox_rbox(Y, rf(InfosX,NaNX), rf(InfosY,NaNY)) ?-
; (InfosX == not_float_int ->
% peut echouer sur float_int/ibox
launch_not_float_int_prio(Y)
- ; InfosX = Box-Rat,
- % peut echiuer sur float,
+ ; InfosX = _Box-Rat,
+ % peut echouer sur float,
launch_box_prio(Y,Rat)))))).
%----------------------------------------------------------------
@@ -194,11 +196,11 @@ test_unify_term_rbox(Y{AttrY}, AttrX) :-
-?->
test_unify_rbox_rbox(Y, AttrX, AttrY).
-test_unify_rbox_rbox(_, AttrX, AttrY) :-
+test_unify_rbox_rbox(_, _AttrX, AttrY) :-
var(AttrY).
/*** VAR + META ***/
% Liaison a une variable non attribuee
-test_unify_rbox_rbox(Y, rf(InfosX,_), rf(InfosY,_)) :-
+test_unify_rbox_rbox(_Y, rf(InfosX,_), rf(InfosY,_)) :-
% Deux variables attribuees dans rbox
% On gere seulement les Infos
((InfosX == InfosY;
@@ -292,17 +294,30 @@ launch_box_prio(Var{rbox:rf(RF,NaN)},Rat) ?- !,
ORat == Rat
; Notify = 1)
; Notify = 1),
+ ((nonvar(RF),
+ (RF == float_int;
+ RF = OBox-_,
+ OBox == ibox))
+ ->
+ protected_denominator(Rat,1)
+ ; true),
float_of_rat(real,rtn,Rat,L),
float_of_rat(real,rtp,Rat,H),
set_typed_intervals(Var,real,[L..H]),
(var(Var) ->
RF \== float,
- (RF == float_int ->
+ ((RF == float_int;
+ nonvar(RF),
+ RF = ibox-_)
+ ->
NBox = ibox,
- denominator(Rat,1)
- ; (RF == not_float_int ->
+ protected_denominator(Rat,1)
+ ; ((RF == not_float_int;
+ nonvar(RF),
+ RF = nibox-_)
+ ->
NBox = nibox,
- denominator(Rat,Den),
+ protected_denominator(Rat,Den),
Den \== 1
; NBox = rbox)),
replace_attribute(Var,rf(NBox-Rat,0),rbox),
@@ -345,9 +360,9 @@ launch_box_prio(Var,Rat) :-
my_notify_constrained(Var),
wake_if_constrained(Constrained).
-is_real_box(_{rbox:rf(Box-_,_)}) ?-
+is_real_box(_{rbox:rf(_Box-_,_)}) ?-
true.
-is_real_box_rat(_{rbox:rf(Box-Rat0,_)},Rat) ?-
+is_real_box_rat(_{rbox:rf(_Box-Rat0,_)},Rat) ?-
nonvar(Rat0),
Rat = Rat0.
@@ -449,7 +464,10 @@ is_float_int_number(Var) :-
is_float_int_number(_{rbox:rf(RF,_)}) ?-
nonvar(RF),
once (RF == float_int;
- RF = ibox-_).
+ RF = ibox-_;
+ RF = rbox-Rat,
+ nonvar(Rat),
+ protected_denominator(Rat,1)).
launch_not_float_int_number(Var) :-
@@ -515,7 +533,7 @@ ensure_not_NaN1(Val) :-
nonvar(Val),
!,
float(Val).
-ensure_not_NaN1(Var{rbox:rf(RF,NaN)}) ?- !,
+ensure_not_NaN1(Var{rbox:rf(_RF,NaN)}) ?- !,
(var(NaN) ->
NaN = 0,
my_notify_constrained(Var),
@@ -533,7 +551,7 @@ check_not_NaN(nan) ?- !,
check_not_NaN(F) :-
float(F),
!.
-check_not_NaN(Var{rbox:rf(RF,NaN)}) ?- !,
+check_not_NaN(_Var{rbox:rf(_RF,NaN)}) ?- !,
NaN == 0.
check_not_NaN(Var) :-
get_type(Var,real).
\ No newline at end of file
diff --git a/Src/COLIBRI/realarith.pl b/Src/COLIBRI/realarith.pl
old mode 100755
new mode 100644
index 97d4e15e28753ed073dcf9934a1b2f3099d5749c..4c689732fed9ad1da41382ede88c9c0ea7c0e8aa
--- a/Src/COLIBRI/realarith.pl
+++ b/Src/COLIBRI/realarith.pl
@@ -1071,8 +1071,10 @@ check_exists_floor_before_susp(Type,NotIntegral,A,B) :-
A == X,
B == Y)
->
- Stop = 1,
- kill_suspension(S),
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1,
+ kill_suspension(S)),
protected_unify(A,B)
; ((G = truncate_bis(Type,X,Y),
A == X,
@@ -1296,8 +1298,10 @@ check_exists_ceiling_before_susp(Type,NotIntegral,A,B) :-
A == X,
B == Y)
->
- Stop = 1,
- kill_suspension(S),
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1,
+ kill_suspension(S)),
protected_unify(A,B)
; true)))),
ceiling_ineqs(Type,A,B,NotIntegral),
@@ -1846,7 +1850,7 @@ real_to_float_ineqs(Type,A,B) :-
!,
get_delta_before_after(A,BeforeA,AfterA),
get_delta_before_after(B,BeforeB,AfterB),
- term_variables((BA,AfterA,BeforeB,AB),Vars),
+ term_variables((BeforeA,AfterA,BeforeB,AfterB),Vars),
% si float(A) Rel float(B) -> A Rel B
% si A Rel B -> float(A) WeakRel float(B)
(foreach(V,Vars),
@@ -2473,8 +2477,10 @@ check_exists_cast_double_to_float_bis(A,B,Stop) :-
; ((member((Susp,cast_float_to_double_bis(V1,V2)),LSusp),
V2 == A)
->
- % le float_to_double est plus contraignant
- Stop = 1,
+ (get_suspension_data(Susp,state,2) ->
+ true
+ ; % le float_to_double est plus contraignant
+ Stop = 1),
protected_unify(B = V1)
; true)).
@@ -3272,6 +3278,15 @@ add_real_bis(1,Type,A,B,C) :-
(var(Continue2) ->
true
; % New
+ ((Type == real,
+ is_float_int_number(A),
+ is_float_int_number(B))
+ ->
+ % real_int
+ congr_add_directe(real,A,B,C),
+ congr_add_inverse(real,C,B,A),
+ congr_add_inverse(real,C,A,B)
+ ; true),
reduce_Res_from_matching_Goals(add_real1,Type,A,B,C),
check_RelABC_add_real(Type,A,B,C),
% Point fixe des projections + lancement/lecture deltas
@@ -3370,6 +3385,27 @@ clean_inf_args_from_res(Type,Res,Args) :-
setval(saved_suspensions,(1,SL))
; true).
+% NEW
+clean_mult_inf_args_from_res(real,Res,Args) ?- !,
+ ((not_inf_bounds(Res),
+ not_zero(Res),
+ float_int_args([Res|Args]))
+ ->
+ %call(spy_here)@eclipse,
+ mreal:dvar_range(Res,L,H),
+ Max is max(abs(L),abs(H)),
+ Min is - Max,
+ (foreach(Arg,Args),
+ param(Min,Max) do
+ set_typed_intervals(Arg,real,[Min..Max]))
+ ; true).
+clean_mult_inf_args_from_res(Type,Res,Args) ?- !,
+ clean_inf_args_from_res(Type,Res,Args).
+
+float_int_args(L) :-
+ (foreach(X,L) do
+ is_float_int_number(X)).
+
% pour tester les bornes des types "reels"
not_inf([X|L]) ?- !,
(foreach(T,[X|L]) do
@@ -3478,12 +3514,12 @@ check_launch_add_int(Type,A,B,C,_,Continue) :-
is_float_int_number(C),
not_inf_bounds(A),
not_inf_bounds(B),
- not_inf_bounds(C))
-/*
+ not_inf_bounds(C),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B),
is_inside_mantissa(Type,C))
-*/
+
->
cast_real_int(Type,A,IA),
cast_real_int(Type,B,IB),
@@ -3553,32 +3589,38 @@ add_real_2_args_equal(Type,X,Y,Z,Continue) :-
mreal:set_typed_intervals(A,Type,NIA))).
%% Simplifications communes avec un "op_real"
add_real_2_args_equal(Type,A,B,C,_) :-
- get_saved_cstr_suspensions(LSusp),
- member((Susp,op_real1(Type,X,Y)),LSusp),
- ( A == X,
- (B == Y,
- Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));%% A + -A = C
- C == Y,
- Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,B)))%% A + B = -A, ie -C + B = C
- %% En nearest, la projection inverse sur B
- %% est -A +|- ulp(A)/2 -A qui donne bien -2A
- ; A == Y,
- (B == X,
- Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));%% -B + B = C
- C == X,
+ get_saved_cstr_suspensions(LSusp),
+ member((Susp,op_real1(Type,X,Y)),LSusp),
+ ( A == X,
+ (B == Y,
+ Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));
+ % A + -A = C
+ C == Y,
+ Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,B)))
+ % A + B = -A, ie -C + B = C
+ % En nearest, la projection inverse sur B
+ % est -A +|- ulp(A)/2 -A qui donne bien -2A
+ ; A == Y,
+ (B == X,
+ Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));
+ % -B + B = C
+ C == X,
Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,B)))%% -C + B = C
- ; B == X,
- (A == Y,
- Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));%% -B + B = C
- C == Y,
- Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,A)))%% A + B = -B, ie A + -C = C
- ; B == Y,
- (A == X,
+ ; B == X,
+ (A == Y,
+ Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));
+ % -B + B = C
+ C == Y,
+ Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,A)))
+ % A + B = -B, ie A + -C = C
+ ; B == Y,
+ (A == X,
Goal = (protected_unify(C=0.0),forbid_infinities(Type,[A,B]));%% A + -A = C
- C == X,
- Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,A)))),%% A + -C = C
- !,
- call_priority(Goal,2).
+ C == X,
+ Goal = (forbid_infinities(Type,[A,B,C]),mult_real_bis(Type,2.0,C,A)))),
+ % A + -C = C
+ !,
+ call_priority(Goal,2).
add_real_2_args_equal(_,_,_,_,1).
forbid_infinities(real,LV) ?- !.
@@ -4041,6 +4083,14 @@ rat_of_decimal_string(Str0,Rat) :-
term_string(Rat0,SRat)),
Rat is Sign*Rat0*RExp.
+rat_of_number(N,R) :-
+ (float(N) ->
+ (abs(N) =:= 1.0Inf ->
+ exit_block('rat_of_infinite')
+ ; number_string(N,SN),
+ rat_of_decimal_string(SN,R))
+ ; rational(N,R)).
+
build_power_10(0,1) :- !.
build_power_10(N,P10) :-
PN is N - 1,
@@ -4375,9 +4425,13 @@ get_rel_between_real_args(A,B,RelAB) :-
((get_type(A,real),
occurs(RelAB0,(=<,>=)),
get_rel_between_real_args_from_cstrs(A,B,RelAB1),
- occurs(RelAB1,(<,>)))
+ occurs(RelAB1,(#,<,>)))
->
- RelAB = RelAB1
+ (RelAB1 == '#' ->
+ (RelAB0 = '=<' ->
+ RelAB = '<'
+ ; RelAB = '>')
+ ; RelAB = RelAB1)
; RelAB = RelAB0)
; mreal:dvar_range(A,MinA,MaxA),
mreal:dvar_range(B,MinB,MaxB),
@@ -4390,7 +4444,15 @@ get_rel_between_real_args(A,B,RelAB) :-
RelAB = '=<'
; RelAB = '<')
; (getval(use_delta,1)@eclipse ->
- RelAB = '?'
+ (((var(A) ->
+ get_type(A,real),
+ get_type(B,real)
+ ; var(B),
+ get_type(B,real)),
+ not_unify(A,B))
+ ->
+ RelAB = '#'
+ ; RelAB = '?')
; get_rel_between_real_args_from_cstrs(A,B,RelAB)))))).
get_rel_between_real_args_from_cstrs(A,B,RelAB) :-
@@ -4411,7 +4473,16 @@ get_rel_between_real_args_from_cstrs(A,B,RelAB) :-
Y == A),
RelAB = '#')),
!.
-get_rel_between_real_args_from_cstrs(A,B,'?').
+get_rel_between_real_args_from_cstrs(A,B,RelAB) :-
+ (((var(A) ->
+ get_type(A,real),
+ get_type(B,real)
+ ; var(B),
+ get_type(B,real)),
+ not_unify(A,B))
+ ->
+ RelAB = '#'
+ ; RelAB = '?').
@@ -5175,11 +5246,7 @@ add_real_dom_bounds(_,FI,Dom1,Dom2,Dom,NewDom) :-
inv_add_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom).
minus_real_dom_bounds(_,_,_,_,Dom,NewDom) :-
@@ -5198,20 +5265,12 @@ minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
inv1_minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; add_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ add_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom).
inv2_minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ minus_real_dom_bounds(Rel12,FI,Dom1,Dom2,Dom,NewDom).
add_real_dom(_,_,_,_,Dom,NewDom) :-
@@ -5234,11 +5293,7 @@ add_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
inv_add_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom).
minus_real_dom(_,_,_,_,Dom,NewDom) :-
@@ -5261,20 +5316,12 @@ minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
inv1_minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; add_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ add_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom).
inv2_minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom) :-
mreal:dom_interval(Dom1,L1),
mreal:dom_interval(Dom2,L2),
- (fail,(occurs(-1.0Inf,(L1,L2));
- occurs(1.0Inf,(L1,L2)))
- ->
- NewDom = Dom
- ; minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom)).
+ minus_real_dom(Rel12,FI,Dom1,Dom2,Dom,NewDom).
@@ -5314,20 +5361,10 @@ add_real_ineqs(Type,A,B,C) :-
add_real_2_args_equal(Type,A,B,C,_Continue)
; true),
ndelta:allow_delta_check,
- ((Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
average_add_real_ineqs(Type,A,B,C),
bin_op_real_ineq(Type,add_real1,A,B,C).
%add_real_ineqs(Type,A,B,C).
add_real_ineqs(Type,A,B,C) :-
- ((Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
average_add_real_ineqs(Type,A,B,C),
bin_op_real_ineq(Type,add_real1,A,B,C).
@@ -5372,6 +5409,7 @@ average_add_real_ineqs(Type,A,B,C) :-
; true).
% pour les real et real_int
+%add_real_int_ineqs(A,B,C) :- !.
add_real_int_ineqs(A,B,C) :-
var(C),
!,
@@ -5400,31 +5438,32 @@ launch_delta_add_real_int(A,B,C) :-
; true)).
launch_delta_add_real_int(A,B,C).
+%minus_real_int_ineqs(A,B,C) :- !.
minus_real_int_ineqs(A,B,C) :-
% A = B + C,
add_real_int_ineqs(B,C,A).
op_real_int_ineqs(A,OpA) :-
- (get_sign(A,SA) ->
- (SA == pos ->
- % SOpA = neg
- X = OpA,
- Y = A
- ; % neg
- X = A,
- Y = OpA),
- mreal:dvar_range(X,LX,HX),
- mreal:dvar_range(Y,LY,HY),
- LD is rational(LY) - rational(HX),
- ((LX == -1.0Inf;
- HY == 1.0Inf)
- ->
- HD = 1.0Inf
- ; HD is rational(HY) - rational(HX)),
- launch_delta(X,Y,+,LD..HD)
- ; true).
- % 0 - A = OpA
-% minus_real_int_ineqs(0.0,A,OpA).
+ getval(use_delta,1)@eclipse,
+ get_sign(A,SA),
+ !,
+ (SA == pos ->
+ % SOpA = neg
+ X = OpA,
+ Y = A
+ ; % neg
+ X = A,
+ Y = OpA),
+ mreal:dvar_range(X,LX,HX),
+ mreal:dvar_range(Y,LY,HY),
+ LD is rational(LY) - rational(HX),
+ ((LX == -1.0Inf;
+ HY == 1.0Inf)
+ ->
+ HD = 1.0Inf
+ ; HD is rational(HY) - rational(HX)),
+ launch_delta(X,Y,+,LD..HD).
+op_real_int_ineqs(_,_).
@@ -5436,6 +5475,7 @@ get_op_real(A,OpA) :-
; A == Y,
OpA = X).
+%bin_op_real_ineq(Type,Op,A,B,C) :- !.
bin_op_real_ineq(Type,Op,A,B,C) :-
% Si on a un carré et que les résultats sont en relation
% alors les arguments non identiques ont la même relation
@@ -5443,6 +5483,7 @@ bin_op_real_ineq(Type,Op,A,B,C) :-
% Les arg2 sur les Op non commutatifs sont en relation opposée
Type == real,
occurs(Op,(add_real1,mult_real1,minus_real1,div_real1)),
+ occurs(Op,(add_real1,minus_real1)),
(occurs(Op,(mult_real1,div_real1)) ->
not_zero(C)
; true),!,
@@ -6460,46 +6501,46 @@ check_NaN_minus_val(_,_).
%:- mode(minus_real_float_intervals(++,++,++,-,-)).
minus_real_float_intervals(Type,-1.0Inf,ValInter,Min,Max) :- !,
- Type \== real,
+ Type \== real,
ValInter \== -1.0Inf,
- Min = Max,
- Min = -1.0Inf.
+ Min = Max,
+ Min = -1.0Inf.
minus_real_float_intervals(Type,1.0Inf,ValInter,Min,Max) :- !,
- Type \== real,
+ Type \== real,
ValInter \== 1.0Inf,
- Min = Max,
- Min = 1.0Inf.
+ Min = Max,
+ Min = 1.0Inf.
minus_real_float_intervals(Type,ValInter,-1.0Inf,Min,Max) :- !,
- Type \== real,
+ Type \== real,
ValInter \== -1.0Inf,
- Min = Max,
- Min = -1.0Inf.
+ Min = Max,
+ Min = -1.0Inf.
minus_real_float_intervals(Type,ValInter,1.0Inf,Min,Max) :- !,
- Type \== real,
+ Type \== real,
ValInter \== 1.0Inf,
- Min = Max,
- Min = 1.0Inf.
+ Min = Max,
+ Min = 1.0Inf.
minus_real_float_intervals(Type,ValInter1,ValInter2,Min,Max) :-
- ((float(ValInter1),
- float(ValInter2))
- ->
- moins_min_max(Type,ValInter1,ValInter2,Min,Max)
- ; min_max_inter(ValInter1,Min1,Max1),
- min_max_inter(ValInter2,Min2,Max2),
- moins_min(Type,Min1,Max2,Min),
- moins_max(Type,Max1,Min2,Max)).
+ ((float(ValInter1),
+ float(ValInter2))
+ ->
+ moins_min_max(Type,ValInter1,ValInter2,Min,Max)
+ ; min_max_inter(ValInter1,Min1,Max1),
+ min_max_inter(ValInter2,Min2,Max2),
+ moins_min(Type,Min1,Max2,Min),
+ moins_max(Type,Max1,Min2,Max)).
%% VARIANTES DE PROJECTIONS APPELEES EN EVALUATION
%% SUR DES VARIABLES ATTRIBUEES
add_real_interval(Val1,Val2,Val) :-
- getval(float_eval,Type)@eclipse,
- set_lazy_domain(Type,Val),
+ getval(float_eval,Type)@eclipse,
+ set_lazy_domain(Type,Val),
add_real_interval_type(Type,Val1,Val2,Val).
add_real_interval_type(real,Val1,Val2,Val) ?- !,
- set_lazy_domain(real,Val1),
+ set_lazy_domain(real,Val1),
set_lazy_domain(real,Val2),
set_lazy_domain(real,Val),
add_real_interval(real,Val1,Val2,Val).
@@ -6528,9 +6569,9 @@ add_real_interval_type(Type,Val1,Val2,Val) :-
add_real_interval(Type,Val10,Val20,Val0) :-
set_lazy_domain(Type,Val0),
- norm_zero(Type,Val10,Val1),
- norm_zero(Type,Val20,Val2),
- norm_zero(Type,Val0,Val),
+ norm_zero(Type,Val10,Val1),
+ norm_zero(Type,Val20,Val2),
+ norm_zero(Type,Val0,Val),
((Type == real,
check_rbox_rat(Val1,Rat1),
check_rbox_rat(Val2,Rat2))
@@ -6543,17 +6584,24 @@ add_real_interval(Type,Val10,Val20,Val0) :-
get_float_int_status(Val,FI),
(Type == real ->
add_real_dom_bounds(?,FI,Dom1,Dom2,Dom,NewDom)
- ; add_float_dom_bounds(Type,?,FI,Dom1,Dom2,Dom,NewDom)),
+ ; add_float_dom_bounds(Type,?,FI,Dom1,Dom2,Dom,NewDom)),
mreal:dvar_set(Val,NewDom)),
- propagate_rbox_status(Type,Val1,Val2,Val).
+ ((Type == real,
+ is_float_int_number(Val1),
+ is_float_int_number(Val2))
+ ->
+ % real_int
+ congr_add_directe(real,Val1,Val2,Val)
+ ; true),
+ propagate_rbox_status(Type,Val1,Val2,Val).
propagate_rbox_status(real,Val1,Val2,Val) :-
- once (float(Val1);is_real_box(Val1)),
- once (float(Val2);is_real_box(Val2)),
- mreal:dvar_size(Val,2),
- !,
- % Les bornes consecutives de Val sont interdites
- launch_box(Val).
+ once (float(Val1);is_real_box(Val1)),
+ once (float(Val2);is_real_box(Val2)),
+ mreal:dvar_size(Val,2),
+ !,
+ % Les bornes consecutives de Val sont interdites
+ launch_box(Val).
propagate_rbox_status(_,_,_,_).
@@ -6670,13 +6718,20 @@ cast_int_real1(Type,A,B) :-
cast_int_real_bis(Type,A,B) :-
save_cstr_suspensions((A,B)),
- cast_int_real_interval(Type,A,B),
((is_float_number(B); % unification avec une entree
not_inf_bounds(B))
%safe_integer_to_real(Type,A)) % A est un entier representable en flottants
->
launch_float_int_number(B)
; true),
+ ((Type == real,
+ is_float_int_number(B),
+ var(A),
+ var(B))
+ ->
+ set_same_congr(A,B)
+ ; true),
+ cast_int_real_interval(Type,A,B),
check_exists_cast_int_real(Type,A,B),
cast_int_real_inst(Type,A,B,Continue),
(var(Continue) ->
@@ -6737,11 +6792,12 @@ cast_int_real_ineqs(Type,I,RI) :-
var(I),
var(RI),
!,
- ((Type == real;
- fail,is_float_int_number(RI),
- is_inside_mantissa(Type,RI))
+ (( % DANGER SUR LIA/convert
+ Type == real,
+ is_float_int_number(RI))
->
- launch_delta(I,RI,=,0)
+ true
+ % launch_delta(I,RI,=,0)
; get_delta_before_after(RI,BR,AR),
term_variables((BR,AR),Vars),
(Vars == [] ->
@@ -6922,8 +6978,8 @@ cast_int_real_inst(real,A,B,Continue) :- !,
; (number(B) ->
inv_int_to_real(real,B,A)
; (is_real_box_rat(B,RB) ->
- denominator(RB,1),
- numerator(RB,A0),
+ protected_denominator(RB,1),
+ protected_numerator(RB,A0),
protected_unify(A,A0)
; Continue = 1))).
%% Mode double/simple nearest
@@ -7336,8 +7392,8 @@ cast_fp_int(1,Type,A,B) ?- !,
uninterp(cast_fp_int,cast_fp_int,[Type],int,[A],B).
cast_fp_int(Cond,Type,A,B) :-
get_priority(Prio),
- set_priority(1),
- ((check_not_NaN(A),
+ set_priority(1),
+ ((check_not_NaN(A),
not_inf([A]))
->
protected_unify(Cond,0),
@@ -7392,7 +7448,14 @@ cast_real_int_bis(Type,A,B) :-
nonvar(Kill))
->
true
- ; cast_real_int_interval(Type,A,B),
+ ; ((Type == real,
+ is_float_int_number(A),
+ var(A),
+ var(B))
+ ->
+ set_same_congr(A,B)
+ ; true),
+ cast_real_int_interval(Type,A,B),
mreal:dvar_domain(A,DomA),
inv_cast_real_int_interval(Type,FIA,B,A),
mreal:dvar_domain(A,NDomA),
@@ -7408,10 +7471,9 @@ cast_real_int_inst(Type,FIA,A,B,Continue) :-
real_to_int(Type,A,B0),
protected_unify(B = B0)
; (is_real_box_rat(A,RA) ->
- denominator(RA,1),
- numerator(RA,B0),
- protected_unify(B,B0),
- Continue = 1
+ protected_denominator(RA,1),
+ protected_numerator(RA,B0),
+ protected_unify(B,B0)
; (number(B) ->
(Type == real ->
RB is rational(B),
@@ -7440,11 +7502,12 @@ cast_real_int_ineqs(Type,RI,I) :-
var(I),
var(RI),
!,
- (((Type == real;
- fail,is_inside_mantissa(Type,RI)),
+ ((% DANGER sur LIA/convert
+ Type == real,
is_float_int_number(RI))
->
- launch_delta(RI,I,=,0)
+ true
+ % launch_delta(RI,I,=,0)
; get_delta_before_after(RI,BR,AR),
term_variables((BR,AR),Vars),
(foreach(V,Vars),
@@ -7838,6 +7901,12 @@ op_real_bis(Type,A,B) :-
% On peut reduire A et B selon Rel
check_delta_op_real(Type,Rel,A,B)
; true),
+ ((Type == real,
+ is_float_int_number(A))
+ ->
+ congr_op_directe(real,A,B),
+ congr_op_directe(real,B,A)
+ ; true),
op_real_interval(Type,A,B),
op_real_interval(Type,B,A),
op_real_ineq(Type,A,B),
@@ -8108,7 +8177,10 @@ check_launch_op_int(Type,A,B,_,Continue) :-
is_float_int_number(A),
is_float_int_number(B),
not_inf_bounds(A),
- not_inf_bounds(B))
+ not_inf_bounds(B),
+
+ is_inside_mantissa(Type,A),
+ is_inside_mantissa(Type,B))
/*
mreal:dvar_range(A,MinA,MaxA),
get_mantissa_size(Type,MSize),
@@ -8118,8 +8190,8 @@ check_launch_op_int(Type,A,B,_,Continue) :-
*/
->
cast_real_int(Type,A,IA),
- cast_real_int(Type,B,IB),
- op(IA,IB)
+ op(IA,IB),
+ cast_int_real(Type,IB,B)
; Continue = 1).
@@ -8221,7 +8293,14 @@ minus_real_interval(Type,Val1,Val2,Val) :-
minus_real_dom_bounds(?,FI,Dom1,Dom2,Dom,NewDom)
; minus_float_dom_bounds(Type,?,FI,Dom1,Dom2,Dom,NewDom)),
mreal:dvar_set(Val,NewDom)),
- propagate_rbox_status(Type,Val1,Val2,Val).
+ propagate_rbox_status(Type,Val1,Val2,Val),
+ ((Type == real,
+ is_float_int_number(Val1),
+ is_float_int_number(Val2))
+ ->
+ % real_int
+ congr_add_inverse(real,Val1,Val2,Val)
+ ; true).
@@ -8239,7 +8318,7 @@ minus_real1(Type,A,B,C) :-
wake_if_other_scheduled(Prio).
% INHIBE
-%check_real_minus_opp(real,A,B,C,1) :- !.
+check_real_minus_opp(real,A,B,C,1) :- !.
check_real_minus_opp(Type,A,B,C,Continue) :-
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LS),
@@ -8260,8 +8339,8 @@ minus_real_bis(Type,A,B,C) :-
%% On utilise les simplifications
minus_real_bis(1,Type,A,B,C) :-
save_cstr_suspensions((A,B,C)),
- clean_inf_args_from_res(Type,C,[A,B]),
propagate_float_int_bin_op(Type,A,B,C),
+ clean_inf_args_from_res(Type,C,[A,B]),
minus_real_inst(Type,A,B,C,Continue),
(var(Continue) ->
true
@@ -8269,7 +8348,16 @@ minus_real_bis(1,Type,A,B,C) :-
minus_real_2_args_equal(Type,A,B,C,Continue1),
(var(Continue1) ->
true
- ; reduce_Res_from_matching_Goals(minus_real1,Type,A,B,C),
+ ; ((Type == real,
+ is_float_int_number(A),
+ is_float_int_number(B))
+ ->
+ % real_int
+ congr_add_inverse(real,A,B,C),
+ congr_add_directe(real,B,C,A),
+ congr_add_inverse(real,A,C,B)
+ ; true),
+ reduce_Res_from_matching_Goals(minus_real1,Type,A,B,C),
check_RelABC_minus_real(Type,A,B,C),
minus_real_rec(Type,A,B,C),
% Les deltas sont calcules apres point fixe
@@ -8375,12 +8463,12 @@ check_launch_minus_int(Type,A,B,C,_,Continue) :-
is_float_int_number(C),
not_inf_bounds(A),
not_inf_bounds(B),
- not_inf_bounds(C))
-/*
+ not_inf_bounds(C),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B),
is_inside_mantissa(Type,C))
-*/
+
->
cast_real_int(Type,A,IA),
cast_real_int(Type,B,IB),
@@ -8390,8 +8478,8 @@ check_launch_minus_int(Type,A,B,C,_,Continue) :-
%% Identites communes real/float
minus_real_2_args_equal(Type,A,A,C,_) ?- !,
- forbid_infinities(Type,[A]),
- protected_unify(C = 0.0).
+ forbid_infinities(Type,[A]),
+ protected_unify(C = 0.0).
minus_real_2_args_equal(Type,A,B,B,Continue) ?- !,
% En nearest, la projection inverse sur A
% est B +|- ulp(B)/2 + B qui donne bien 2B
@@ -8511,19 +8599,9 @@ minus_real_ineqs(Type,A,B,C) :-
; true)),
minus_minus_add_real_ineqs(Type,A,B,C),
ndelta:allow_delta_check,
- ((Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
bin_op_real_ineq(Type,minus_real1,A,B,C).
%minus_real_ineqs(Type,A,B,C).
minus_real_ineqs(Type,A,B,C) :-
- ((Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
bin_op_real_ineq(Type,minus_real1,A,B,C).
minus_minus_add_real_ineqs(Type,A,B,C) :-
@@ -8819,7 +8897,7 @@ launch_minus_minus_add_real_ineqs(Type,A,B,C,Exact,G) :-
minus_real_inst(Type,A,A,C,_) ?-
(Type \== real ->
not_inf_bounds(A)
- ; % infinis interdits en real
+ ; % infinis interdits en real mais pas en real_int
true),
!,
protected_unify(C,0.0).
@@ -9758,8 +9836,8 @@ inv2_minus_float_interval_list(Type,Min1,Max1,[I2|LInter2],Min,Max,LInter,EndLIn
%% Les combinaisons +/-1.0Inf et 0.0 pour A et B
%% sont interdites pour ne pas produire de NaN
mult_real(A,B,C) :-
- getval(float_eval,Type)@eclipse,
- mult_real_type(Type,A,B,C).
+ getval(float_eval,Type)@eclipse,
+ mult_real_type(Type,A,B,C).
mult_real_type(real,A,B,C) ?- !,
mult_real(real,A,B,C).
@@ -9837,8 +9915,8 @@ check_real_mult_opp(Type,A,B,C,Continue) :-
mult_real_bis(Type,A,B,C) :-
save_cstr_suspensions((A,B,C)),
get_saved_cstr_suspensions(LSusp),
- clean_inf_args_from_res(Type,C,[A,B]),
propagate_float_int_bin_op(Type,A,B,C),
+ clean_mult_inf_args_from_res(Type,C,[A,B]),
clear_Goals_mult_real(Type,A,B,C),
check_zero_mult_real(Type,A,B,C),
mult_real_sign(Type,A,B,C),
@@ -9851,7 +9929,14 @@ mult_real_bis(Type,A,B,C) :-
check_launch_mult_int(Type,A,B,C,Continue1,Continue2),
(var(Continue2) ->
true
- ; mult_real_rec(Type,A,B,C),
+ ; ((Type == real,
+ is_float_int_number(A),
+ is_float_int_number(B))
+ ->
+ % real_int
+ fp_congr_mult(real,A,B,C)
+ ; true),
+ mult_real_rec(Type,A,B,C),
mult_real_ineqs(Type,A,B,C),
mult_real_inst(Type,A,B,C,Continue3),
(var(Continue3) ->
@@ -9879,12 +9964,12 @@ check_launch_mult_int(Type,A,B,C,_,Continue) :-
is_float_int_number(C),
not_inf_bounds(A),
not_inf_bounds(B),
- not_inf_bounds(C))
-/*
+ not_inf_bounds(C),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B),
is_inside_mantissa(Type,C))
-*/
+
->
cast_real_int(Type,A,IA),
cast_real_int(Type,B,IB),
@@ -9984,11 +10069,16 @@ mult_real_sign(real,A,B,C) :- !,
(get_sign_real(B,SB) ->
prod_sign(SA,SB,SC),
set_sign(real,C,SC)
- ; (get_sign_real(C,SC) ->
+ ; ((not_zero(C),
+ get_sign_real(C,SC))
+ ->
prod_sign(SA,SC,SB),
set_sign(real,B,SB)
; true))
- ; (get_sign_real(C,SC) ->
+ ; ((not_zero(C),
+ get_sign_real(B,SB),
+ get_sign_real(C,SC))
+ ->
prod_sign(SB,SC,SA),
set_sign(real,A,SA)
; true))).
@@ -9997,18 +10087,14 @@ mult_real_sign(Type,A,B,C) :-
(get_sign(B,SB) ->
prod_sign(SA,SB,SC),
set_sign(Type,C,SC)
- ; (((Type == real ->
- not_zero(C)
- ; true),
+ ; ((not_zero(C),
get_sign(C,SC))
->
prod_sign(SA,SC,SB),
set_sign(Type,B,SB)
; true))
- ; ((get_sign(B,SB),
- (Type == real ->
- not_zero(C)
- ; true),
+ ; ((not_zero(C),
+ get_sign(B,SB),
get_sign(C,SC))
->
prod_sign(SB,SC,SA),
@@ -10032,19 +10118,9 @@ mult_real_ineqs(Type,A,B,C) :-
; true)),
prod_real_ineqs_from_res(Type,A,SA,B,SB,C),
ndelta:allow_delta_check,
- ((fail,Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
bin_op_real_ineq(Type,mult_real1,A,B,C).
%mult_real_ineqs(Type,A,B,C).
mult_real_ineqs(Type,A,B,C) :-
- ((fail,Type == real,
- not_zero(C))
- ->
- check_exists_lin_expr_giving_diff_args(real,C,0.0,_Stop)
- ; true),
bin_op_real_ineq(Type,mult_real1,A,B,C).
% seulement dans le cas ou les arguments sont signés
@@ -10873,7 +10949,9 @@ mult_real_inst0(Type,V,F,V,Continue) ?-
not_zero(F),
!,
mult_real_inst0(Type,F,V,V,Continue).
-
+mult_real_inst0(real,V,V,V,_) ?-
+ !,
+ set_typed_intervals(V,real,[0.0,1.0]).
mult_real_inst0(Type,A,B,C,Continue) :-
Type \== real,
once (is_decimal_normal_power_two(Type,A),
@@ -10913,8 +10991,21 @@ mult_real_inst0(real,A,B,C,Continue) :- !,
protected_unify(B,0.0)
; (not_zero(B) ->
protected_unify(A,0.0)
- ; mult_real_two_floats(A,B,C,Continue)))
- ; mult_real_two_floats(A,B,C,Continue)))).
+ ; refute_null_mult_real(A,B,Work),
+ (nonvar(Work) ->
+ true
+ ; mult_real_two_floats(A,B,C,Continue))))
+ ; ((nonvar(C),
+ occurs(C,(-1.0,1.0)),
+ is_float_int_number(A),
+ is_float_int_number(B))
+ ->
+ set_typed_intervals(A,real,[-1.0,1.0]),
+ (C == 1.0 ->
+ protected_unify(A,B)
+ ; % C = -1
+ op_real(real,A,B))
+ ; mult_real_two_floats(A,B,C,Continue))))).
%% Mode double/simple
mult_real_inst0(Type,A,B,C,Continue) :-
(is_fzero(A) ->
@@ -10962,7 +11053,24 @@ mult_real_inst0(Type,A,B,C,Continue) :-
; true)),
Continue = 1
; Continue = 1)))))).
-
+
+refute_null_mult_real(A,B,Work) :-
+ get_priority(P),
+ set_priority(12),
+ (not (protected_unify(A,0.0),
+ wake)
+ ->
+ set_priority(P),
+ protected_unify(B,0.0),
+ Work = 1
+ ; (not (protected_unify(B,0.0),
+ wake)
+ ->
+ set_priority(P),
+ protected_unify(A,0.0),
+ Work = 1
+ ; set_priority(P))).
+
mult_float_nearest(float_simple,A,B,C) :- !,
getval(floating_biblio,F)@eclipse,
mult_simple_float(A,B,0,F,_,C).
@@ -11270,9 +11378,8 @@ inv_mult_real_dom(real,RelAB,FIA,FIB,FIC,DomA,DomB,DomC,NDomC) :- !,
mreal:dom_interval(DomA,InterA),
mreal:dom_interval(DomB,InterB),
mreal:dom_interval(DomC,InterC),
- ((InterC = [F],float(F);
- fail,occurs(-1.0Inf,(InterA,InterB));
- fail,occurs(1.0Inf,(InterA,InterB)))
+ ((InterC = [F],
+ float(F))
->
NDomC = DomC
; ((not (InterB = [B],
@@ -12303,7 +12410,7 @@ div_real_dom(Rel12,FI1,FI2,FI,Dom1,Dom2,Dom,NewDom) :-
% A FAIRE: integrer Rel12
mreal:dom_interval(Dom1,Inter1),
mreal:dom_interval(Dom2,Inter2),
- ((Inter1 == [Z1],
+ ((Inter1 = [Z1],
Z1 == 0.0;
(Inter2 = [MP1],
MP1 == 1.0;
@@ -12317,7 +12424,7 @@ div_real_dom(Rel12,FI1,FI2,FI,Dom1,Dom2,Dom,NewDom) :-
op_real_intervals(Type,Inter1,-1.0Inf,[],Inter),
mreal:list_to_typed_dom(real,Inter,NDom0),
mreal:dom_intersection(Dom,NDom0,NDom,_)),
- reduce_float_int_domain(real,FI,NewDom0,NewDom))
+ reduce_float_int_domain(real,FI,NDom,NewDom))
; ((Inter1 = [I1],
Inter2 = [I2])
->
@@ -13177,7 +13284,7 @@ average_real_ineqs(Type,A,B,C) :-
not not (isNormal(float_simple,FAd2,BN),
BN == 1))
->
- call(spy_here)@eclipse,
+ %call(spy_here)@eclipse,
protected_unify(FC,FAd2)
; true))))).
average_real_ineqs(Type,A,B,C).
@@ -13197,12 +13304,12 @@ check_launch_div_int(Type,A,B,C,_,Continue) :-
is_float_int_number(C),% donc reste nul ?
not_inf_bounds(A),
not_inf_bounds(B),
- not_inf_bounds(C))
-/*
+ not_inf_bounds(C),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B),
is_inside_mantissa(Type,C))
-*/
+
->
cast_real_int(Type,A,IA),
cast_real_int(Type,B,IB),
@@ -15731,7 +15838,12 @@ power_real_bis(Type,Val1,N,Val) :-
(ground((Val1,N)) ->
% Val rationnel ?
true
- ; power_real_rec(Type,Val1,N,Val)),
+ ; ((Type == real,
+ is_float_int_number(Val1))
+ ->
+ fp_congr_power(real,Val1,N,Val)
+ ; true),
+ power_real_rec(Type,Val1,N,Val)),
% Ajouter des inegalites quand c est possible ici
% gt_real_ineq(Type,Val,Val1),
check_before_susp_power_real(Type,Val1,N,Val)
@@ -15747,11 +15859,11 @@ check_launch_power_int(Type,A,N,B,_,Continue) :-
is_float_int_number(A),
is_float_int_number(B),
not_inf_bounds(A),
- not_inf_bounds(B))
-/*
+ not_inf_bounds(B),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B))
-*/
+
->
cast_real_int(Type,A,IA),
power(IA,N,IB),
@@ -16682,6 +16794,11 @@ square_real_bis(Type,Val1,Val) :-
% peut deleguer le calcul aux entiers
check_launch_square_int(Type,Val1,Val,Continue,Continue1),
(nonvar(Continue1) ->
+ ((Type == real,
+ is_float_int_number(Val1))
+ ->
+ fp_congr_power(real,Val1,2,Val)
+ ; true),
square_real_rec(Type,Val1,Val),
check_before_susp_square_real(Type,Val1,Val)
; true)).
@@ -16738,11 +16855,11 @@ check_launch_square_int(Type,A,B,_,Continue) :-
is_float_int_number(A),
is_float_int_number(B),
not_inf_bounds(A),
- not_inf_bounds(B))
-/*
+ not_inf_bounds(B),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B))
-*/
+
->
cast_real_int(Type,A,IA),
square(IA,IB),
@@ -17723,6 +17840,16 @@ min_real_bis(Type,A,B,C) :-
(not_zero(B) ->
launch_real_ineq(=<,Type,C,B)
; true)),
+ % congruences
+ ((Type == real,
+ is_float_int_number(A),
+ is_float_int_number(B),
+ exists_congr(A,CA,MA),
+ exists_congr(B,CB,MB))
+ ->
+ union_congr(CA,CB,MA,MB,CC,MC,_),
+ launch_congr(C,CC,MC)
+ ; true),
min_real_free_inst(Type,A,B,C,Continue),
(nonvar(Continue) ->
((A == -0.0 ->
@@ -17955,10 +18082,10 @@ max_real(Type,A,B,C) :-
wake_if_other_scheduled(Prio).
max_real_bis(Type,A,B,C) :-
- save_cstr_suspensions((A,B)),
- % Factorisation
- check_exists_max_real(Type,A,B,C),
- mreal:dvar_domain(A,DomA),
+ save_cstr_suspensions((A,B)),
+ % Factorisation
+ check_exists_max_real(Type,A,B,C),
+ mreal:dvar_domain(A,DomA),
mreal:dvar_domain(B,DomB),
mreal:dom_union(DomA,DomB,dom(_,IC,_),_),
mreal:set_typed_intervals(C,Type,IC),
@@ -17990,6 +18117,16 @@ max_real_bis(Type,A,B,C) :-
launch_real_ineq(>=,Type,C,B)
; true)),
set_prio_inst([A,B,C],3,4,Prio),
+ % congruences
+ ((Type == real,
+ is_float_int_number(A),
+ is_float_int_number(B),
+ exists_congr(A,CA,MA),
+ exists_congr(B,CB,MB))
+ ->
+ union_congr(CA,CB,MA,MB,CC,MC,_),
+ launch_congr(C,CC,MC)
+ ; true),
max_real_free_inst(Type,A,B,C,Continue),
(nonvar(Continue) ->
((A == -0.0 ->
@@ -18235,16 +18372,26 @@ abs_val_real_bis(Type,Val,Abs) :-
check_launch_abs_int(Type,Val,Abs,Continue,Continue1),
(var(Continue1) ->
true
- ; % Propagation de Val vers Abs
- abs_val_real_interval(Type,Val,Abs),
- % Propagation de Abs vers Val
- mreal:get_intervals(Abs,IntAbs),
- op_real_intervals(Type,IntAbs,-1.0Inf,[],NegIntAbs),
- append(NegIntAbs,IntAbs,PosNegAbs),
- mreal:list_to_typed_dom(Type,PosNegAbs,DomPosNegAbs),
- % PMO dvar_update reduit l'intervalle si float_int
- mreal:dvar_update(Val,DomPosNegAbs),
- check_before_susp_abs_val_real(Type,Val,Abs))).
+ ; ((Type == real,
+ is_float_int_number(A))
+ ->
+ congr_abs_directe(Val,Abs,Stop),
+ (var(Stop) ->
+ congr_abs_inverse(Val,Abs,Stop)
+ ; true)
+ ; true),
+ (var(Stop) ->
+ % Propagation de Val vers Abs
+ abs_val_real_interval(Type,Val,Abs),
+ % Propagation de Abs vers Val
+ mreal:get_intervals(Abs,IntAbs),
+ op_real_intervals(Type,IntAbs,-1.0Inf,[],NegIntAbs),
+ append(NegIntAbs,IntAbs,PosNegAbs),
+ mreal:list_to_typed_dom(Type,PosNegAbs,DomPosNegAbs),
+ % PMO dvar_update reduit l'intervalle si float_int
+ mreal:dvar_update(Val,DomPosNegAbs),
+ check_before_susp_abs_val_real(Type,Val,Abs)
+ ; true))).
abs_val_real_inst(Type,Val,Abs,Continue) :-
(number(Val) ->
@@ -18281,15 +18428,15 @@ check_launch_abs_int(Type,A,B,_,Continue) :-
is_float_int_number(A),
is_float_int_number(B),
not_inf_bounds(A),
- not_inf_bounds(B))
-/*
+ not_inf_bounds(B),
+
is_inside_mantissa(Type,A),
is_inside_mantissa(Type,B))
-*/
+
->
cast_real_int(Type,A,IA),
- cast_real_int(Type,B,IB),
- abs_val(IA,IB)
+ abs_val(IA,IB),
+ cast_int_real(Type,IB,B)
; Continue = 1).
@@ -18583,12 +18730,16 @@ check_launch_diff_int(Type,A,B,_,Continue) :-
((Type == real,
is_float_int_number(A),
is_float_int_number(B),
+/*
not_inf_bounds(A),
not_inf_bounds(B))
+*/
+ is_inside_mantissa(Type,A),
+ is_inside_mantissa(Type,B))
->
cast_real_int(Type,A,IA),
- cast_real_int(Type,B,IB),
- launch_diff_int(IA,IB)
+ launch_diff_int(IA,IB),
+ cast_int_real(Type,IB,B)
; Continue = 1).
diff_real_ineq(Type,A,A) ?- !,
@@ -18920,12 +19071,37 @@ check_launch_geq(Type,A,B,_,Continue) :-
((Type == real,
is_float_int_number(A),
is_float_int_number(B),
- not_inf_bounds(A),
- not_inf_bounds(B))
+ is_inside_mantissa(Type,A),
+ is_inside_mantissa(Type,B))
->
- cast_real_int(Type,A,IA),
- cast_real_int(Type,B,IB),
- launch_geq(IA,IB)
+ (((not_inf_bounds(A);
+ is_real_box_rat(A,_)),
+ (not_inf_bounds(B);
+ is_real_box_rat(B,_)))
+ ->
+ cast_real_int(Type,A,IA),
+ launch_geq(IA,IB),
+ cast_int_real(Type,IB,B)
+ ; % cas pathologiques
+ ((is_real_box_rat(A,RA),
+ RA > 0_1,
+ is_real_box(B))
+ ->
+ mreal:dvar_range(B,LB,HB),
+ LIB is integer(LB),
+ HIB is integer(RA),
+ mfd:set_intervals(IB,[LIB..HIB]),
+ cast_int_real(real,IB,B)
+ ; ((is_real_box_rat(B,RB),
+ RB < 0_1,
+ is_real_box(A))
+ ->
+ mreal:dvar_range(A,LA,HA),
+ LIA is integer(RB),
+ HIA is integer(HA),
+ mfd:set_intervals(IA,[LIA..HIA]),
+ cast_int_real(real,IA,A)
+ ; Continue = 1)))
; Continue = 1).
geq_real_ineq(Type,A,A) ?- !.
@@ -18998,6 +19174,7 @@ geq_real_ineq(Type,A,B) :-
launch_delta(B,A,+,MinDelta..MaxDelta)))
; true).
+%geq_real_int_ineq(A,B) :- !.
geq_real_int_ineq(A,B) :-
% A et B sont déjà réduits
var(A),
@@ -19235,18 +19412,43 @@ check_launch_gt(Type,A,B,_,Continue) :-
((Type == real,
is_float_int_number(A),
is_float_int_number(B),
- not_inf_bounds(A),
- not_inf_bounds(B))
+ is_inside_mantissa(Type,A),
+ is_inside_mantissa(Type,B))
->
- cast_real_int(Type,A,IA),
- cast_real_int(Type,B,IB),
- launch_gt(IA,IB)
+ (((not_inf_bounds(A);
+ is_real_box_rat(A,_)),
+ (not_inf_bounds(B);
+ is_real_box_rat(B,_)))
+ ->
+ cast_real_int(Type,A,IA),
+ launch_gt(IA,IB),
+ cast_int_real(Type,IB,B)
+ ; % cas pathologiques
+ ((is_real_box_rat(A,RA),
+ RA > 0_1,
+ is_real_box(B))
+ ->
+ mreal:dvar_range(B,LB,HB),
+ LIB is integer(LB),
+ HIB is integer(RA)-1,
+ mfd:set_intervals(IB,[LIB..HIB]),
+ cast_int_real(real,IB,B)
+ ; ((is_real_box_rat(B,RB),
+ RB < 0_1,
+ is_real_box(A))
+ ->
+ mreal:dvar_range(A,LA,HA),
+ LIA is integer(RB)+1,
+ HIA is integer(HA),
+ mfd:set_intervals(IA,[LIA..HIA]),
+ cast_int_real(real,IA,A)
+ ; Continue = 1)))
; Continue = 1).
is_cast_or_float_int(A) :-
once (is_float_int_number(A);
is_real_box_rat(A,RatA),
- denominator(RatA,1);
+ protected_denominator(RatA,1);
get_saved_cstr_suspensions(LSusp),
member((_,cast_int_real1(_,IA,AA)),LSusp),
A == AA).
@@ -19293,6 +19495,7 @@ gt_real_ineq(Type,A,B) :-
launch_delta(B,A,+,MinDelta..MaxDelta)))
; true).
+%gt_real_int_ineq(A,B) :- !.
gt_real_int_ineq(A,B) :-
% A et B sont déjà réduits
var(A),
@@ -19730,9 +19933,13 @@ analyze_real_ineq(geq_real,Type,A,B,G,S,Stop) :-
analyze_geq_real_ineq(Type,A,B,G,S,Stop).
analyze_diff_real_ineq(Type,A,B,diff_real(_,_,_),S,Stop) ?-
- Stop = 1.
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1).
analyze_diff_real_ineq(Type,A,B,gt_real(_,_,_),S,Stop) ?-
- Stop = 1.
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1).
analyze_diff_real_ineq(Type,A,B,gt_real_reif(_,_,_,_),S,_Stop) ?-
% ???
true.
@@ -19746,7 +19953,9 @@ analyze_gt_real_ineq(Type,A,B,diff_real(_,_,_),S,Stop) ?-
analyze_gt_real_ineq(Type,A,B,gt_real(Type,X,Y),S,Stop) ?-
A == X,
B == Y,
- Stop = 1.
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1).
analyze_gt_real_ineq(Type,A,B,gt_real_reif(Type,X,Y,Bool),S,_Stop) ?-
kill_suspension(S),
(A == X ->
@@ -19768,7 +19977,10 @@ analyze_geq_real_ineq(Type,A,B,diff_real(_,_,_),S,Stop) ?-
analyze_geq_real_ineq(Type,A,B,gt_real(Type,X,Y),S,Stop) ?-
A == X,
B == Y,
- Stop = 1.
+ Stop = 1,
+ (get_suspension_data(S,state,2) ->
+ check_gt_real(Type,A,B)
+ ; true).
analyze_geq_real_ineq(Type,A,B,gt_real_reif(Type,X,Y,Bool),S,Stop) ?-
(A == X ->
% B == Y
@@ -19777,20 +19989,24 @@ analyze_geq_real_ineq(Type,A,B,gt_real_reif(Type,X,Y,Bool),S,Stop) ?-
kill_suspension(S),
protected_unify(A,B)
; (Bool == 1 ->
- % il va travailler
- Stop = 1
+ (get_suspension_data(S,state,2) ->
+ true
+ ; % il va travailler
+ Stop = 1)
; true))
; % A == Y,
% B == X,
kill_suspension(S),
protected_unify(Bool,0)).
analyze_geq_real_ineq(Type,A,B,geq_real(Type,X,Y),S,Stop) ?-
- Stop = 1,
((A == X,
B == Y)
->
- true
- ; kill_suspension(S),
+ (get_suspension_data(S,state,2) ->
+ true
+ ; Stop = 1)
+ ; Stop = 1,
+ kill_suspension(S),
protected_unify(A = B)).
diff --git a/Src/COLIBRI/simplex_ocaml/Dockerfile b/Src/COLIBRI/simplex_ocaml/Dockerfile
index 06a0b5faa49592c5d6da3bd57d8f5001b9e4ba9f..f46c312714400d9a4cb792d9cdfcb018be598425 100644
--- a/Src/COLIBRI/simplex_ocaml/Dockerfile
+++ b/Src/COLIBRI/simplex_ocaml/Dockerfile
@@ -1,18 +1,5 @@
-FROM ocaml/opam2:debian-8
-
-ENV OPAMSWITCH=4.07
-
-RUN [ "opam", "depext", "--install", "dune", "ocplib-simplex", "zarith", "parsexp", "menhir", "fmt", "spelll", "uutf", "gen" ]
-
-ENV OPAMSWITCH=4.08
-
-RUN [ "opam", "depext", "--install", "dune", "ocplib-simplex", "zarith", "parsexp", "menhir", "fmt", "spelll", "uutf", "gen" ]
-
-ENV OPAMSWITCH=4.09
-
-RUN [ "opam", "depext", "--install", "dune", "ocplib-simplex", "zarith", "parsexp", "menhir", "fmt", "spelll", "uutf", "gen" ]
-
-ENV OPAMSWITCH=4.10
+# ocaml/opam:debian-10-ocaml-4.11
+FROM ocaml/opam@sha256:e570e5dd74bb4986e022d5c25fe42579288d11fb0b60df13794632a8f0a110b6
RUN [ "opam", "depext", "--install", "dune", "ocplib-simplex", "zarith", "parsexp", "menhir", "fmt", "spelll", "uutf", "gen" ]
diff --git a/Src/COLIBRI/simplex_ocaml/dolmen/src/typecheck/misc.ml b/Src/COLIBRI/simplex_ocaml/dolmen/src/typecheck/misc.ml
index 9967ea23d2e281df85659ef372b721fb44fa73b7..bdf8dd73e829291914847db5feb1f97cb3f9e6e2 100644
--- a/Src/COLIBRI/simplex_ocaml/dolmen/src/typecheck/misc.ml
+++ b/Src/COLIBRI/simplex_ocaml/dolmen/src/typecheck/misc.ml
@@ -232,9 +232,9 @@ module Fuzzy_Map = struct
let empty = I.empty
- let rec seq_to_list_ s = match s() with
- | Seq.Nil -> []
- | Seq.Cons (x,y) -> x :: seq_to_list_ y
+ let rec seq_to_list_ s = match s with
+ | `Nil -> []
+ | `Cons (x,y) -> x :: seq_to_list_ (y ())
let get t id =
let s = Dolmen.Std.Id.(id.name) in
diff --git a/Src/COLIBRI/smt_import.old b/Src/COLIBRI/smt_import.old
index d7d220e2510fe3daf7257ec30be61e0e21c8cdae..be8aeee1fbb17d42346e3dce6e52b40f6acecb02 100644
--- a/Src/COLIBRI/smt_import.old
+++ b/Src/COLIBRI/smt_import.old
@@ -1,66 +1,30 @@
+
:- set_flag(syntax_option,iso_base_prefix).
:- set_flag(syntax_option,based_bignums).
% pour forcer l'utilisation des "real integral"
% a la place des entiers bornes
:- setval(def_real_for_int,1).
+%:- setval(def_real_for_int,0).
% pour indiquer une abstaction de forall/exists
:- setval(quantifier,0).
% pour activer le scrambler en mode test
:- setval(scrambler,0)@eclipse.
+
+:- include([new_parser_builtins]).
+
parse_smtlib_file(File,Res) :-
+ % passera à 1 si Int rencontré
+ setval(int_used,0)@eclipse,
% defaut pour la simulation des entiers non bornes
getval(def_real_for_int,RI),
setval(real_for_int,RI)@eclipse,
-/*
- get_flag(pid,Pid),
- concat_atom(["filtered_file_",Pid],FilteredFile),
get_flag(hostarch,ARCH),
((ARCH == "i386_nt";
ARCH == "x86_64_nt")
->
- concat_string(["del ",FilteredFile],Rm),
- EXEC_SCRIPT = "cmd.exe /D /C"
- ; concat_string(["rm -f ",FilteredFile],Rm),
- EXEC_SCRIPT = "sh -c"),
- (get_file_info(FilteredFile,readable,on) ->
- system(Rm)
- ; true),
- (getenv("FILTER_SMTLIB_FILE",FILTER_SMTLIB_FILE)
- ->
- true
- ; FILTER_SMTLIB_FILE = "filter_smtlib_file"),
- (fail,getval(scrambler,1)@eclipse ->
- % avec scrambling
- concat_string([EXEC_SCRIPT," \"",FILTER_SMTLIB_FILE," < ",File," > ",FilteredFile,"\""],Com)
- ; % sans scrambling
- concat_string([EXEC_SCRIPT," \"",FILTER_SMTLIB_FILE," -seed 0 < ",File," > ",FilteredFile,"\""],Com)),
- exec(Com,[null,null,null],ComPid),
- wait(ComPid,Status),
- Status == 0,
- set_numeral_type_from_logic(File,SetLogic),
- open(FilteredFile,read,Stream),
- read_string(Stream,end_of_file,_,Str),
- close(Stream),
- system(Rm),
- clean_FileString(Str,ResStr),
- split_string(Str,"|","",LStr),
- (LStr = [ResStr] ->
- true
- ; remove_quotes(LStr,NLStr),
- join_string(NLStr,"|",ResStr)),
- open(string(ResStr),read,NStream),
- open('check.smt2',write,Check),
- writeln(Check,SetLogic),
- read_smtlib_file(NStream,Check,Res),
- close(Check),
-*/
- get_flag(hostarch,ARCH),
- ((ARCH == "i386_nt";
- ARCH == "x86_64_nt")
- ->
- setval(scrambling,0)@eclipse
+ setval(scrambler,0)@eclipse
; true),
(getval(scrambler,1)@eclipse ->
% avec scrambling, uniquement sous Linux
@@ -70,19 +34,21 @@ parse_smtlib_file(File,Res) :-
Status == 0,
FilteredFile = 'check.smt2'
; FilteredFile = File),
- % On force la logique ALL et on met tout dans check.smt2
- set_ALL_logic(FilteredFile),
- p_simplex_ocaml_create_parser('check.smt2',PEnv),
+ p_simplex_ocaml_create_parser(FilteredFile,PEnv),
read_dolmen_terms(PEnv,Res).
read_dolmen_terms(PEnv,Terms) :-
p_simplex_ocaml_parser_next(PEnv,DTerm),
(DTerm == end ->
Terms = []
- ; Terms = [Term|ETerms],
- dolmen_to_colibri_term(DTerm,Term),
+ ; dolmen_to_colibri_term(DTerm,Term),
+ (Term = [_|_] ->
+ append(Term,ETerms,Terms)
+ ; Terms = [Term|ETerms]),
read_dolmen_terms(PEnv,ETerms)).
+dolmen_to_colibri_term(set_logic(SLog),Term) ?- !,
+ Term = 'set-logic'(SLog).
dolmen_to_colibri_term(exit,Term) ?- !,
Term = exit.
dolmen_to_colibri_term(solve(Terms),Term) ?- !,
@@ -91,119 +57,222 @@ dolmen_to_colibri_term(solve(Terms),Term) ?- !,
; % A DEFINIR SI BESOIN
(foreach(DTerm,Terms),
foreach(CTerm,CTerms) do
- term_from_dolmen_term(DTerm,CTerm)),
+ term_from_dolmen_term(DTerm,[],CTerm)),
Term = 'check-sat-assuming'(CTerms)).
dolmen_to_colibri_term(get_value(Terms),Term) ?- !,
(foreach(DTerm,Terms),
foreach(CTerm,CTerms) do
- term_from_dolmen_term(DTerm,CTerm)),
+ term_from_dolmen_term(DTerm,[],CTerm)),
Term = 'get-value'(CTerms).
dolmen_to_colibri_term(get_assignment,Term) ?- !,
Term = 'get-assignment'.
dolmen_to_colibri_term(get_model,Term) ?- !,
Term = 'get-model'.
-dolmen_to_colibri_term(initError(error(String)),_) ?- !,
+dolmen_to_colibri_term(initError(String),_) ?- !,
concat_string(["(error \"",String,"\")"],Error),
- writeln(Error),
+ writeln(error,Error),
exit_block(abort).
dolmen_to_colibri_term(error(String),_) ?- !,
split_string(String,"\"","",LNString),
join_string(LNString,"'",NString),
concat_string(["(error \"",NString,"\")"],Error),
- writeln(Error),
+ writeln(error,Error),
exit_block(syntax).
-dolmen_to_colibri_term(set_info(colon(symbol(SFlagInfo),
- symbol(SInfo))),Term) ?- !,
+dolmen_to_colibri_term(warn(String),Term) ?- !,
+ (getval(no_dolmen_warning,1)@eclipse ->
+ true
+ ; split_string(String,"\"","",LNString),
+ join_string(LNString,"'",NString),
+ concat_string(["(warning \"",NString,"\")"],Error),
+ writeln(error,Error)),
+ Term = 'set-info'("Info","").
+dolmen_to_colibri_term(set_info(app(symbol(SFlagInfo),
+ [symbol(SInfo)])),Term) ?- !,
atom_string(FlagInfo,SFlagInfo),
atom_string(Info,SInfo),
Term = 'set-info'(FlagInfo,Info).
-dolmen_to_colibri_term(set_option(colon(symbol(SFlagOption),
- symbol(SOption))),Term) ?- !,
+dolmen_to_colibri_term(set_option(app(symbol(SFlagOption),
+ [symbol(SOption)])),Term) ?- !,
atom_string(FlagOption,SFlagOption),
- atom_string(Option,SOption),
+ (SFlagOption == ":colibri_intSize" ->
+ term_string(Option,SOption)
+ ; atom_string(Option,SOption)),
Term = 'set-option'(FlagOption,Option).
-dolmen_to_colibri_term(decl([term_decl(id(Id,_,_),fun(_,InSorts,
+dolmen_to_colibri_term(decl([term_decl(id(Id,_,_),fun(Poly,InSorts,
OutSort))]),Term) ?-
!,
fun_id_from_dolmen_id(Id,FId),
+ make_poly_vars(Poly,PolyVars),
(foreach(InSort,InSorts),
- foreach(Sort,ISorts) do
- sort_from_dolmen_sort(InSort,Sort)),
- sort_from_dolmen_sort(OutSort,OSort),
- Term = 'declare-fun'(FId,ISorts,OSort).
-dolmen_to_colibri_term(term_def(id(Id,_,_),
- fun(_,DInSorts,DOutSort),
- _,
+ foreach(Sort,ISorts),
+ param(PolyVars) do
+ sort_or_polyvar_from_dolmen_sort(InSort,PolyVars,Sort)),
+ sort_or_polyvar_from_dolmen_sort(OutSort,PolyVars,OSort),
+ (Poly == [] ->
+ Term = 'declare-fun'(FId,ISorts,OSort)
+ ; Term = 'declare-poly-fun'(FId,ISorts,OSort)),
+ add_declared_fun(FId,ISorts,OSort).
+dolmen_to_colibri_term(decl([type_decl(id(SIdSort, _, base), Ar)]),
+ Term) ?-
+ !,
+ atom_string(IdSort,SIdSort),
+ Term = 'declare-sort'(IdSort,Ar).
+dolmen_to_colibri_term(def([term_def(id(Id,_,_),
+ % _Poly pas == a Poly !!!
+ fun(_Poly,DInSorts,DOutSort),
+ Poly,
DFormals,
- _,
- DTerm),
+ Poly,
+ DTerm)]),
Term) ?- !,
fun_id_from_dolmen_id(Id,FId),
- formals_from_dolmen_formals(DFormals,Formals),
- sort_from_dolmen_sort(DOutSort,OutSort),
- term_from_dolmen_term(DTerm,Def),
+ make_poly_vars(Poly,PolyVars),
+ formals_from_dolmen_formals(DFormals,PolyVars,Formals),
+ sort_or_polyvar_from_dolmen_sort(DOutSort,PolyVars,OutSort),
+ term_from_dolmen_term(DTerm,PolyVars,Def),
Term = 'define-fun'(FId,Formals,OutSort,Def).
dolmen_to_colibri_term(hyp(DTerm),Term) ?- !,
- term_from_dolmen_term(DTerm,Hyp),
- Term = assert(Hyp).
-dolmen_to_colibri_term(type_def(_),Term) ?- !,
+ term_from_dolmen_term(DTerm,[],Hyp),
+ remove_upper_as(Hyp,NHyp,_),
+ flatten_and_assert(NHyp,Term).
+dolmen_to_colibri_term(def([type_def(_)]),Term) ?- !,
% deja substitue, on peut l'ignorer normalement !
Term = assert(true).
-fun_id_from_dolmen_id(SFun,Fun) :-
- atom_string(Fun,SFun).
+make_poly_vars(Poly,PolyVars) :-
+ (foreach(Sort,Poly),
+ fromto([],IPV,OPV,PolyVars) do
+ (Sort = id(IdPoly,_,_) ->
+ OPV = [(IdPoly,VPoly)|IPV]
+ ; OPV = IPV)).
+
+
+flatten_and_assert(and(LHyp),LAssert) ?- !,
+ (foreach(Hyp,LHyp),
+ foreach(Assert,LAssert0) do
+ remove_upper_as(Hyp,NHyp,_),
+ flatten_and_assert(NHyp,Assert)),
+ flatten(LAssert0,LAssert).
+flatten_and_assert(A and B,LAssert) ?- !,
+ remove_upper_as(A,NA,_),
+ flatten_and_assert(NA,LA),
+ remove_upper_as(B,NB,_),
+ flatten_and_assert(NB,LB),
+ append(LA,LB,LAssert0),
+ flatten(LAssert0,LAssert).
+flatten_and_assert(A,assert(NA)) :-
+ remove_upper_as(A,NA,_).
+fun_id_from_dolmen_id(SFun,Fun) :-
+ atom_string(Fun0,SFun),
+ check_overloaded(Fun0,Fun).
+
+check_overloaded(colibri_real_isIntegral,colibri_isIntegral) :- !.
+check_overloaded(colibri_fp_isIntegral,colibri_isIntegral) :- !.
+check_overloaded(colibri_min_int,colibri_min) :- !.
+check_overloaded(colibri_min_real,colibri_min) :- !.
+%check_overloaded(colibri_min_fp,colibri_min) :- !.
+check_overloaded(colibri_min_fp,'fp.min') :- !.
+check_overloaded(colibri_max_int,colibri_max) :- !.
+check_overloaded(colibri_max_real,colibri_max) :- !.
+%check_overloaded(colibri_max_fp,colibri_max) :- !.
+check_overloaded(colibri_max_fp,'fp.max') :- !.
+check_overloaded(colibri_exp_real,colibri_exp) :- !.
+check_overloaded(colibri_exp_fp,colibri_exp) :- !.
+check_overloaded(colibri_ln_real,colibri_ln) :- !.
+check_overloaded(colibri_ln_fp,colibri_ln) :- !.
+check_overloaded(Fun,Fun).
+
+sort_or_polyvar_from_dolmen_sort(InSort,[],Sort) ?- !,
+ sort_from_dolmen_sort(InSort,Sort).
+sort_or_polyvar_from_dolmen_sort(InSort,PolyVars,Sort) :-
+ findall((VarId,P),cgiveInstanceAndPath(var(_),InSort,VarId,P),VarIdPaths),
+ (foreach((var(id(Id,_,_)),Path),VarIdPaths),
+ fromto(InSort,IIS,OIS,NInSort),
+ param(PolyVars) do
+ once member((Id,VarId),PolyVars),
+ creplace_at_path_in_term(Path,IIS,poly(VarId),OIS)),
+ sort_from_dolmen_sort(NInSort,Sort).
+
sort_from_dolmen_sort(app(id(SSort, _, DSort), ArgSorts),Sort) ?- !,
- col_sort_from_dsort(DSort,Sort0),
+ (DSort == base ->
+ atom_string(Sort0,SSort)
+ ; col_sort_from_dsort(DSort,Sort0)),
(ArgSorts == [] ->
Sort = Sort0
; (foreach(ArgSort,ArgSorts),
foreach(ASort,ASorts) do
sort_from_dolmen_sort(ArgSort,ASort)),
Sort =.. [Sort0|ASorts]).
+sort_from_dolmen_sort(Var,Var).
-formals_from_dolmen_formals([],[]).
+formals_from_dolmen_formals([],_,[]).
formals_from_dolmen_formals([formal(id(Id,_,_),DSort)|DFormals],
- Formals) ?-
+ PolyVars,Formals) ?-
fun_id_from_dolmen_id(Id,FId),
- sort_from_dolmen_sort(DSort,Sort),
+ sort_or_polyvar_from_dolmen_sort(DSort,PolyVars,Sort),
Formals = [(FId,Sort)|EFormals],
- formals_from_dolmen_formals(DFormals,EFormals).
+ formals_from_dolmen_formals(DFormals,PolyVars,EFormals).
% une variable definie par un declare-fun
-term_from_dolmen_term(var(id(Id,_,_)),Term) ?- !,
+term_from_dolmen_term(var(id(Id,_,_)),_,Term) ?- !,
fun_id_from_dolmen_id(Id,Term).
% les constantes
-term_from_dolmen_term(app(id(SId,_,TId), [], []),Term) ?- !,
+term_from_dolmen_term(app(id(SId,_,TId), [], []),_PolyVars,Term) ?- !,
(TId \== base ->
term_from_dolmen_const(TId,Term)
; fun_id_from_dolmen_id(SId,Term)).
% les applications de fonctions
-term_from_dolmen_term(app(id(Id, _, TId), _Poly, DTerms),Term) ?- !,
+term_from_dolmen_term(app(id(Id,_,TId),Poly,DTerms),OldPolyVars,Term) ?- !,
fun_id_from_dolmen_id(Id,CId),
+ (OldPolyVars == [] ->
+ make_poly_vars(Poly,PolyVars)
+ ; PolyVars = OldPolyVars),
(foreach(DTerm,DTerms),
- foreach(CTerm,CTerms) do
- term_from_dolmen_term(DTerm,CTerm)),
+ foreach(CTerm,CTerms),
+ param(PolyVars) do
+ term_from_dolmen_term(DTerm,PolyVars,CTerm)),
build_cterm(CId,TId,CTerms,Term).
% les autres
-
-term_from_dolmen_term(binder(Binder,DTerm),Term) ?- !,
+term_from_dolmen_term(binder(Binder,DTerm),OldPolyVars,Term) ?- !,
functor(Binder,FBinder,_),
(FBinder == letin ->
+ % A revoir pour les PolyVars !!!
arg(1,Binder,DPairs),
FTerm = let,
(foreach([id(SId,_,_),SIdDef],DPairs),
- foreach((Id,IdDef),CPairs) do
+ foreach((Id,IdDef),CPairs),
+ param(PolyVars) do
atom_string(Id,SId),
- term_from_dolmen_term(SIdDef,IdDef)),
- term_from_dolmen_term(DTerm,CTerm),
- Term =.. [let,CPairs,CTerm]
- ; % A améliorer, on aura une abstraction booléenne
- Term =.. [FBinder,[],true]).
-term_from_dolmen_term(term(DSort,DTerm),Term) ?- !,
- sort_from_dolmen_sort(DSort,Sort),
- term_from_dolmen_term(DTerm,CTerm),
+ term_from_dolmen_term(SIdDef,OldPolyVars,IdDef)),
+ term_from_dolmen_term(DTerm,OldPolyVars,CTerm),
+ Term =.. [FTerm,CPairs,CTerm]
+ ; % forall ou exists
+ arg(1,Binder,Poly),
+ make_poly_vars(Poly,PolyVars0),
+ % Les nouvelles PolyVars0 masquent les anciennes
+ % de meme Id
+ (foreach((Id,IdVar),OldPolyVars),
+ fromto(PolyVars0,IPV,OPV,PolyVars),
+ param(PolyVars0) do
+ (member((Id,_),PolyVars0) ->
+ OPV = IPV
+ ; OPV = [(Id,IdVar)|IPV])),
+ arg(2,Binder,DFormals),
+ ((FTerm == forall,
+ Poly \== [],
+ DFormals == [])
+ ->
+ Formals = []
+ ; formals_from_dolmen_formals(DFormals,PolyVars,Formals)),
+ term_from_dolmen_term(DTerm,PolyVars,CTerm),
+ (Formals == [] ->
+ Term = CTerm
+ ; Term =.. [FBinder,Formals,CTerm])).
+term_from_dolmen_term(term(DSort,DTerm),PolyVars,Term) ?- !,
+ sort_or_polyvar_from_dolmen_sort(DSort,PolyVars,Sort),
+ term_from_dolmen_term(DTerm,PolyVars,CTerm),
(Sort == 'Int' ->
Term = as(CTerm,Sort)
; ((Sort == 'Real',
@@ -214,10 +283,18 @@ term_from_dolmen_term(term(DSort,DTerm),Term) ?- !,
->
% Melange Int et Real
Term = ITerm
- ; Term = CTerm)).
-term_from_dolmen_term(term(DSort,_Poly,DTerm),Term) ?- !,
- term_from_dolmen_term(term(DSorts,DTerm),Term).
-
+ ; ((nonvar(Sort),
+ Sort = poly(NSort))
+ ->
+ true
+ ; NSort = Sort),
+ Term = as(CTerm,NSort))).
+term_from_dolmen_term(term(DSort,Poly,DTerm),OldPolyVars,Term) ?- !,
+ (OldPolyVars == [] ->
+ make_poly_vars(Poly,PolyVars)
+ ; PolyVars = OldPolyVars),
+ term_from_dolmen_term(term(DSorts,DTerm),PolyVars,Term).
+% COLIBRI builtins ????
term_from_dolmen_const(true,Term) ?- !,
Term = true.
@@ -226,7 +303,11 @@ term_from_dolmen_const(false,Term) ?- !,
term_from_dolmen_const(integer(SI),Term) ?- !,
number_string(Term,SI).
term_from_dolmen_const(decimal(SR),Term) ?- !,
- Term = realString(SR).
+ term_string(TSR,SR),
+ (integer(TSR) ->
+ concat_string([SR,"_1"],NSR)
+ ; NSR = SR),
+ Term = realString(NSR).
term_from_dolmen_const(bitvec(SB),Term) ?- !,
% SB est toujours une chaine binaire
Term = bv("b",SB).
@@ -273,7 +354,7 @@ get_col_id(CId,TId,ColId,Chainable) :-
chainable_op(Op) :-
atomic(Op),
occurs(Op,(and,or,xor,+,-,*,div,mod,/,=>,=,distinct,<,>,<=,>=,
- 'fp.eq','fp.leq','fp.lt','fp.geq','fp.gt',bvand,bvor)).
+ 'fp.eq','fp.leq','fp.lt','fp.geq','fp.gt',bvand,bvor,bvadd,bvmul)).
get_col_id('Ite',_,ite) :- !.
get_col_id('Equals',_,=) :- !.
@@ -299,42 +380,82 @@ get_col_id('GreaterThan',_,>) :- !.
get_col_id('GreaterOrEqual',_,>=) :- !.
get_col_id('Divisible',_,divisible) :- !.
-get_col_id('Bitv_concat',_,concat) :- !.
-get_col_id('Bitv_extract',_,extract) :- !.
-get_col_id('Bitv_repeat',_,repeat) :- !.
-get_col_id('Bitv_zero_extend',_,zero_extend) :- !.
-get_col_id('Bitv_sign_extend',_,sign_extend) :- !.
-get_col_id('Bitv_rotate_right',_,rotate_right) :- !.
-get_col_id('Bitv_rotate_left',_,rotate_left) :- !.
-get_col_id('Bitv_not',_,bvnot) :- !.
-get_col_id('Bitv_and',_,bvand) :- !.
-get_col_id('Bitv_or',_,bvor) :- !.
-get_col_id('Bitv_xor',_,bvxor) :- !.
-get_col_id('Bitv_nand',_,bvnand) :- !.
-get_col_id('Bitv_nor',_,bvnor) :- !.
-get_col_id('Bitv_xnor',_,bvxnor) :- !.
-get_col_id('Bitv_comp',_,bvcomp) :- !.
-get_col_id('Bitv_neg',_,bvneg) :- !.
-get_col_id('Bitv_add',_,bvadd) :- !.
-get_col_id('Bitv_sub',_,bvsub) :- !.
-get_col_id('Bitv_mul',_,bvmul) :- !.
-get_col_id('Bitv_udiv',_,bvudiv) :- !.
-get_col_id('Bitv_urem',_,bvurem) :- !.
-get_col_id('Bitv_sdiv',_,bvsdiv) :- !.
-get_col_id('Bitv_srem',_,bvsrem) :- !.
-get_col_id('Bitv_smod',_,bvsmod) :- !.
-get_col_id('Bitv_shl',_,bvshl) :- !.
-get_col_id('Bitv_shr',_,bvshr) :- !.
-get_col_id('Bitv_ashr',_,bavshr) :- !.
-get_col_id('Bitv_lshr',_,bvlshr) :- !.
-get_col_id('Bitv_ult',_,bvult) :- !.
-get_col_id('Bitv_ule',_,bvule) :- !.
-get_col_id('Bitv_ugt',_,bvugt) :- !.
-get_col_id('Bitv_uge',_,bvuge) :- !.
-get_col_id('Bitv_slt',_,bvslt) :- !.
-get_col_id('Bitv_sle',_,bvsle) :- !.
-get_col_id('Bitv_sgt',_,bvsgt) :- !.
-get_col_id('Bitv_sge',_,bvsge) :- !.
+get_col_id(_,bitv_concat,concat) :- !.
+get_col_id(_,bitv_extract(I,J),[extract,I,J]) :- !.
+get_col_id(SR,bitv_repeat,[repeat,N]) :- !,
+ atom_string(SR,SSR),
+ once append_strings("bitv_repeat_",SN,SSR),
+ number_string(N,SN).
+get_col_id(ZExt,bitv_zero_extend,[zero_extend,S]) :- !,
+ atom_string(ZExt,SZExt),
+ once append_strings("zero_extend_",SS,SZExt),
+ number_string(S,SS).
+get_col_id(SExt,bitv_sign_extend,[sign_extend,S]) :- !,
+ atom_string(SExt,SSExt),
+ once append_strings("sign_extend_",SS,SSExt),
+ number_string(S,SS).
+get_col_id(_,bitv_rotate_right(N),[rotate_right,N]) :- !.
+get_col_id(_,bitv_rotate_left(N),[rotate_left,N]) :- !.
+
+get_col_id(_,bitv_not,bvnot) :- !.
+%get_col_id('Bitv_not',_,bvnot) :- !.
+get_col_id(_,bitv_and,bvand) :- !.
+%get_col_id('Bitv_and',_,bvand) :- !.
+get_col_id(_,bitv_or,bvor) :- !.
+%get_col_id('Bitv_or',_,bvor) :- !.
+get_col_id(_,bitv_xor,bvxor) :- !.
+%get_col_id('Bitv_xor',_,bvxor) :- !.
+get_col_id(_,bitv_nand,bvnand) :- !.
+%get_col_id('Bitv_nand',_,bvnand) :- !.
+get_col_id(_,bitv_nor,bvnor) :- !.
+%get_col_id('Bitv_nor',_,bvnor) :- !.
+get_col_id(_,bitv_xnor,bvxnor) :- !.
+%get_col_id('Bitv_xnor',_,bvxnor) :- !.
+get_col_id(_,bitv_comp,bvcomp) :- !.
+%get_col_id('Bitv_comp',_,bvcomp) :- !.
+get_col_id(_,bitv_neg,bvneg) :- !.
+%get_col_id('Bitv_neg',_,bvneg) :- !.
+get_col_id(_,bitv_add,bvadd) :- !.
+%get_col_id('Bitv_add',_,bvadd) :- !.
+get_col_id(_,bitv_sub,bvsub) :- !.
+%get_col_id('Bitv_sub',_,bvsub) :- !.
+get_col_id(_,bitv_mul,bvmul) :- !.
+%get_col_id('Bitv_mul',_,bvmul) :- !.
+get_col_id(_,bitv_udiv,bvudiv) :- !.
+%get_col_id('Bitv_udiv',_,bvudiv) :- !.
+get_col_id(_,bitv_urem,bvurem) :- !.
+%get_col_id('Bitv_urem',_,bvurem) :- !.
+get_col_id(_,bitv_sdiv,bvsdiv) :- !.
+%get_col_id('Bitv_sdiv',_,bvsdiv) :- !.
+get_col_id(_,bitv_srem,bvsrem) :- !.
+%get_col_id('Bitv_srem',_,bvsrem) :- !.
+get_col_id(_,bitv_smod,bvsmod) :- !.
+%get_col_id('Bitv_smod',_,bvsmod) :- !.
+get_col_id(_,bitv_shl,bvshl) :- !.
+%get_col_id('Bitv_shl',_,bvshl) :- !.
+get_col_id(_,bitv_shr,bvshr) :- !.
+%get_col_id('Bitv_shr',_,bvshr) :- !.
+get_col_id(_,bitv_ashr,bvashr) :- !.
+%get_col_id('Bitv_ashr',_,bvashr) :- !.
+get_col_id(_,bitv_lshr,bvlshr) :- !.
+%get_col_id('Bitv_lshr',_,bvlshr) :- !.
+
+get_col_id(_,bitv_ult,bvult) :- !.
+%get_col_id('Bitv_ult',_,bvult) :- !.
+get_col_id(_,bitv_ule,bvule) :- !.
+%get_col_id('Bitv_ule',_,bvule) :- !.
+get_col_id(_,bitv_ugt,bvugt) :- !.
+%get_col_id('Bitv_ugt',_,bvugt) :- !.
+get_col_id(_,bitv_uge,bvuge) :- !.
+%get_col_id('Bitv_uge',_,bvuge) :- !.
+get_col_id(_,bitv_slt,bvslt) :- !.
+%get_col_id('Bitv_slt',_,bvslt) :- !.
+get_col_id(_,bitv_sle,bvsle) :- !.
+%get_col_id('Bitv_sle',_,bvsle) :- !.
+get_col_id(_,bitv_sgt,bvsgt) :- !.
+%get_col_id('Bitv_sgt',_,bvsgt) :- !.
+get_col_id(_,bitv_sge,bvsge) :- !.
+%get_col_id('Bitv_sge',_,bvsge) :- !.
get_col_id('fp.abs',_,'fp.abs') :- !.
get_col_id('fp.neg',_,'fp.neg') :- !.
@@ -366,15 +487,18 @@ get_col_id('to_fp',ieee_format_to_fp(EB,SB),[ieee_to_fp,EB,SB]) :- !.
% Specialiser les autres to_fp ?
get_col_id('to_fp',fp_to_fp(E,S,EB,SB),[to_fp,EB,SB]) :- !.
get_col_id('to_fp',real_to_fp(EB,SB),[to_fp,EB,SB]) :- !.
-get_col_id('to_fp',sbv_to_fp(Size,EB,SB),[to_fp,EB,SB]) :- !.
-get_col_id('to_fp',ubv_to_fp(Size,EB,SB),[to_fp_unsigned,EB,SB]) :- !.
-
-get_col_id('fp.to_ubv',to_ubv(EB,SB,Size),['fp.to_ubv',Size]) :- !.
-get_col_id('fp.to_sbv',to_sbv(EB,SB,Size),['fp.to_sbv',Size]) :- !.
+% c'est pas toujours bien rangé !!!!
+get_col_id('to_fp',sbv_to_fp(_,EB,SB),[to_fp,EB,SB]) :- !.
+get_col_id('to_fp',ubv_to_fp(_,EB,SB),[to_fp_unsigned,EB,SB]) :- !.
+get_col_id('fp.to_ubv',to_ubv(Size,_,_),['fp.to_ubv',Size]) :- !.
+get_col_id('fp.to_sbv',to_sbv(Size,_,_),['fp.to_sbv',Size]) :- !.
get_col_id('fp.to_real',_,'fp.to_real') :- !.
get_col_id('Select',_,select) :- !.
+get_col_id('Const',_,const) :- !.
get_col_id('Store',_,store) :- !.
+get_col_id(nat2bv,colibri_builtin("nat2bv",[Size]),[nat2bv,Size]) :- !.
+get_col_id(int2bv,colibri_builtin("int2bv",[Size]),[int2bv,Size]) :- !.
col_sort_from_dsort(int,'Int') :- !.
col_sort_from_dsort(real,'Real') :- !.
@@ -385,8 +509,10 @@ col_sort_from_dsort(bitv(N),'_'('BitVec',N)) :- !.
col_sort_from_dsort(float(EB,SB),FSort) :- !,
FSort = '_'('FloatingPoint',EB,SB).
-
-
+add_declared_fun(FId,InSorts,OutSort) :-
+ getval(declared_funs,DFs-EDFs),
+ EDFs = [(FId,InSorts,OutSort)|NEDFs],
+ setval(declared_funs,DFs-NEDFs).
:- setval(num_logic_type,int).
@@ -397,371 +523,15 @@ get_real_int_type_from_logic(Type) :-
((Type0 == int,
getval(real_for_int,1)@eclipse)
->
- Type = real
+ Type = real_int
; Type = Type0).
get_real_int_type_from_logic(_).
-set_ALL_logic(File) :-
- open(File,read,Stream),
- read_string(Stream,end_of_file,_,Str),
- close(Stream),
- (substring(Str,Before,Len,After,"(set-logic ") ->
- substring(Str,0,Before,_,Start),
- NBefore is Before+Len,
- substring(Str,NBefore,After,NAfter,StrEnd),
- once substring(StrEnd,LogicLen,1,LenEnd,")"),
- SLogicLen is LogicLen + 1,
- substring(StrEnd,SLogicLen,LenEnd,0,End),
- join_string([Start,"(set-logic ALL)",End],"",NStr)
- ; NStr = Str),
- open('check.smt2',write,Check),
- write(Check,NStr),
- close(Check),
- setval(num_logic_type,int).
-
-set_numeral_type_from_logic(File,SetLogic) :-
- open(File,read,Stream),
- read_string(Stream,end_of_file,_,Str),
- close(Stream),
- (substring(Str,Before,Len,After,"(set-logic ALL") ->
- % Real et Int possibles, un integer est forcement
- % un Int
- !,
- Type = int,
- SetLogic = "(set-logic ALL)"
- ; substring(Str,Before,Len,After,"(set-logic QF_"),
- NBefore is Before+Len,
- substring(Str,NBefore,After,_,StrEnd),
- substring(StrEnd,LogicLen,1,_,")"),
- substring(StrEnd,0,LogicLen,_,StrLogic),
- !,
- concat_string(["(set-logic QF_",StrLogic,")"],SetLogic),
- (append_strings(Pref,"RA",StrLogic) ->
- (append_strings(Pref1,"I",Pref) ->
- Type = int
- ; Type = real)
- ; (append_strings(Pref,"RDL",StrLogic) ->
- Type = real
- ; Type = int))),
- setval(num_logic_type,Type).
-set_numeral_type_from_logic(File,"").
-
-
-clean_FileString(Str,ResStr) :-
- split_string(Str,"|","",LStr),
- (LStr = [ResStr] ->
- true
- ; remove_quotes(LStr,NLStr),
- join_string(NLStr,"|",ResStr)).
-
-remove_quotes([First,Second|Str],[First,NSecond|NStr]) :- !,
- split_string(Second,"'","",LSecond),
- (LSecond = [NSecond] ->
- true
- ; join_string(LSecond,"!",NSecond)),
- remove_quotes(Str,NStr).
-remove_quotes(End,End).
-
-read_smtlib_file(Stream,Check,LT) :-
- (at_eof(Stream) ->
- close(Stream),
- LT = []
- ; read(Stream,T0),
- (T0 == end_of_file ->
- close(Stream),
- LT = []
- ;
- (T0 = [T] ->
- true
- ; T = T0),
- dump_sexpr_from_list(Check,T),
- nl(Check),
- ((T = [SetGet,Flag|_],
- (%SetGet == 'set-option';
- SetGet == 'get-option';
- SetGet == 'set-info',
- Flag \== ':status'))
- ->
- ELT = LT
- ; build_smt_term(T,NT),
- LT = [NT|ELT]),
- read_smtlib_file(Stream,Check,ELT))).
-
-dump_sexpr_from_list(Stream,[H|T]) :- !,
- write(Stream,"("),
- (foreach(ST,[H|T]),
- param(Stream) do
- dump_sexpr_from_list(Stream,ST),
- write(Stream," ")),
- write(Stream,")").
-dump_sexpr_from_list(Stream,[]) :- !,
- write(Stream,"()").
-dump_sexpr_from_list(Stream,Atom) :-
- ((Atom == 'check-sat';
- Atom == 'exit')
- ->
- write(Stream,"("),
- write(Stream,Atom),
- write(Stream,")")
- ; write(Stream,Atom)).
-
+/*
:- export
op(1200,fx,':').
-
-build_smt_term([H|T],Term) ?- !,
- build_smt_func(H,AH),
- build_smt_term0(AH,T,Term).
-build_smt_term(H,AH) :-
- build_smt_func(H,AH).
-
-build_smt_term0(forall,T,Term) ?- !,
- build_smt_term_forall_exists_let(forall,T,Term).
-build_smt_term0(exists,T,Term) ?- !,
- build_smt_term_forall_exists_let(exists,T,Term).
-build_smt_term0(let,T,Term) ?- !,
- build_smt_term_forall_exists_let(let,T,Term).
-build_smt_term0(#,T,Term) ?- !,
- T = [ABV],
- term_string(ABV,SBV),
- once (append_strings(BX,End,SBV),
- string_length(BX,1)),
- Term = bv(BX,End).
-build_smt_term0('declare-fun',T,Term) ?- !,
- T = [LName,LSorts,LSort],
- build_smt_term(LName,Name),
- build_smt_list(LSorts,Sorts),
- build_smt_term(LSort,Sort),
- Term = 'declare-fun'(Name,Sorts,Sort).
-build_smt_term0('define-fun',T,Term) ?- !,
- T = [LName,LTypedVars,LSort,LExpr],
- build_smt_term(LName,Name),
- build_smt_list_pairs(LTypedVars,TypedVars),
- build_smt_term(LSort,Sort),
- build_smt_term(LExpr,Expr),
- Term = 'define-fun'(Name,TypedVars,Sort,Expr).
-build_smt_term0('declare-const',T,Term) ?- !,
- T = [LName,LSort],
- build_smt_term(LName,Name),
- build_smt_term(LSort,Sort),
- Term = 'declare-const'(Name,Sort).
-build_smt_term0('define-const',T,Term) ?- !,
- T = [LName,LSort,LExpr],
- build_smt_term(LName,Name),
- build_smt_term(LSort,Sort),
- build_smt_term(LExpr,Expr),
- Term = 'define-const'(Name,Sort,Expr).
-build_smt_term0('define-sort',T,Term) ?- !,
- T = [LName,LS,Expr],
- build_smt_term(LName,Name),
- build_smt_list(LS,SortArgs),
- build_smt_term(Expr,SortExpr),
- Term = 'define-sort'(Name,SortArgs,SortExpr).
-build_smt_term0('get-value',T,Term) ?- !,
- T = [TermList],
- build_smt_list(TermList,LExpr),
- Term = 'get-value'(LExpr).
-build_smt_term0(divisible(N),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = divisible(ComArg,N).
-build_smt_term0(extract(I,J),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = extract(I,J,ComArg).
-build_smt_term0(to_fp(I,J),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. [to_fp,I,J|Args].
-build_smt_term0(to_fp_unsigned(I,J),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. [to_fp_unsigned,I,J|Args].
-build_smt_term0('fp.to_ubv'(Size),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. ['fp.to_ubv',Size|Args].
-build_smt_term0('fp.to_sbv'(Size),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. ['fp.to_sbv',Size|Args].
-build_smt_term0('nat2bv'(Size),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. ['nat2bv',Size|Args].
-build_smt_term0('int2bv'(Size),T,Term) ?- !,
- build_smt_term_args(T,Args),
- Term =.. ['int2bv',Size|Args].
-build_smt_term0(repeat(I),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = repeat(I,ComArg).
-build_smt_term0(zero_extend(I),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = zero_extend(I,ComArg).
-build_smt_term0(sign_extend(I),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = sign_extend(I,ComArg).
-build_smt_term0(rotate_left(I),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = rotate_left(I,ComArg).
-build_smt_term0(rotate_right(I),T,Term) ?- !,
- build_smt_term_args(T,ComArgs),
- ComArgs = [ComArg],
- Term = rotate_right(I,ComArg).
-build_smt_term0(AH,T,Term) :- !,
- build_smt_term_args(T,ComArgs),
- % les foncteurs chainable ou pairwise
- (chainable_op(AH) ->
- Term =.. [AH,ComArgs]
- ; Term =.. [AH|ComArgs]).
-
-build_smt_term_forall_exists_let(AH,T,Term) ?- !,
- T = [LTypedVars,LExpr],
- build_smt_list_pairs(LTypedVars,NLTypedVars),
- build_smt_term(LExpr,Expr),
- Term =.. [AH,NLTypedVars,Expr].
-
-
-build_smt_list_pairs([],[]).
-build_smt_list_pairs([[A,B]|LP],[(NA,NB)|NLP]) :-
- build_smt_term(A,NA),
- build_smt_term(B,NB),
- build_smt_list_pairs(LP,NLP).
-
-build_smt_list([],[]).
-build_smt_list([A|L],[NA|NL]) :-
- build_smt_term(A,NA),
- build_smt_list(L,NL).
-
-
-% pour reconstruire des termes a partir des listes
-% retournees par le parseur du scrambleur
-termify([H|T],Term) ?- !,
- termify(H,NH),
- termify_args(T,NT),
- (compound(NH) ->
- NH =.. [FH|Args],
- append(Args,NT,ANT),
- Term =.. [FH|ANT]
- ; Term =.. [NH|NT]).
-termify(Atom,Term) :-
- atom_string(Atom,Str),
- (string_to_term(Str,Term0) ->
- ((var(Term0);
- compound(Term0))
- ->
- Term = Atom
- ; Term = Term0)
- ; (append_strings("#",SBV,Str) ->
- Term =.. ['#',SBV]
- ; Term = Str)).
-
-termify_args([],[]).
-termify_args([I|L],[IT|LT]) :-
- termify(I,IT),
- termify_args(L,LT).
-
-string_to_term(Str,Term) :-
- set_event_handler(7,fail/0),
- set_event_handler(114,fail/0),
- set_event_handler(119,fail/0),
- (term_string(Term,Str) ->
- reset_event_handler(7),
- reset_event_handler(114),
- reset_event_handler(119)
- ; reset_event_handler(7),
- reset_event_handler(114),
- reset_event_handler(119),
- fail).
-
-build_smt_term_args([],[]).
-build_smt_term_args([T|LT],[A|AL]) :-
- build_smt_term(T,A),
- build_smt_term_args(LT,AL).
-
-build_smt_func(Atom,Term) :-
- atomic(Atom),
- !,
- atom_string(Atom,Str),
- (string_to_term(Str,Term0) ->
- (var(Term0) ->
- Term = Atom
- ; (compound(Term0) ->
- Term = Atom
- ; (float(Term0) ->
- Term = realString(Str)
- ; Term = Term0)))
- ; (append_strings("#",SBV,Str) ->
- once (append_strings(BX,End,SBV),
- string_length(BX,1)),
- Term = bv(BX,End)
- ; Term = Atom)).
-
-% INUTILE ?
-build_smt_func(H,AH) :-
- var(H),
- !,
- open(string(""),write,Stream),
- %write(Stream,H),
- printf(Stream,"%w",H),
- get_stream_info(Stream,name,SH),
- close(Stream),
- (append_strings("_",_,SH) ->
- AH = '_'
- ; atom_string(AH,SH)).
-
-build_smt_func(H,AH) :-
- (number(H);
- atomic(H)),
- !,
- AH = H.
-build_smt_func(H,AH) :-
- ((H =.. [F,A,B],
- occurs(F,('-','.')),
- atomic(A),
- atomic(B))
- ->
- concat_atom([A,'_',B],AH)
- ; ((H = [_,DF,I,J],
- atomic(DF),
- occurs(DF,(extract,to_fp,to_fp_unsigned)))
- ->
- build_smt_term(I,TI),
- build_smt_term(J,TJ),
- AH =.. [DF,TI,TJ]
- ; ((H = [_,DF,Size],
- atomic(DF),
- occurs(DF,('fp.to_ubv','fp.to_sbv','nat2bv','int2bv')))
- ->
- build_smt_term(Size,TSize),
- AH =.. [DF,TSize]
- ; ((H = [_,UF,I],
- atomic(UF),
- occurs(UF,(divisible,repeat,zero_extend,sign_extend,
- rotate_left,rotate_right)))
- ->
- build_smt_term(I,TI),
- AH =.. [UF,TI]
- ; term_string(H,SH),
- atom_string(AH,SH))))).
-
-
-
-/* Str = "
-(set-option :produce-models true)
-(set-logic QF_LIA)
-(declare-fun x () Int)
-(declare-fun y () Int)
-(assert (= (+ x y) 9))
-(assert (= (+ (* 2 x) (* 3 y)) 22))
-(check-sat)
-(get-value (x))
-(get-value ((- x y) (+ 2 y)))
-",
-parse_smtlib_string(Str,LTerm),
-init_binding,
-(foreach(Term,LTerm) do
-smt_interp(Term,ITerm,_),
-call(ITerm)).
*/
+
get_info(':name') :- !,
writeln(output,"( :name \"colibri\")").
get_info(':version') :- !,
@@ -778,12 +548,15 @@ get_info(Key) :-
check_sat :-
+ setval(unknown_quantifier_abstraction,0)@eclipse,
(current_suspension(_) ->
check_sat0
; (getval(quantifier,1) ->
setval(diag_code,(unknown,2))@eclipse,
- writeln(output,unknown)
- ; check_sat_vars,
+ writeln(output,unknown),
+ setval(unknown_quantifier_abstraction,1)@eclipse
+ ; setval(unknown_quantifier_abstraction,0)@eclipse,
+ check_sat_vars,
setval(diag_code,(sat,1))@eclipse,
writeln(output,sat))).
@@ -791,65 +564,76 @@ check_sat0 :-
% pour les unknowm lies aux
% contraintes residuelles en Real
setval(real_unknown,0)@eclipse,
- block(((solve_cstrs,
- getval(quantifier,0),
- suspensions(LSusp),
- (foreach(Susp,LSusp) do
- get_suspension_data(Susp,goal,Goal),
- (Goal = uninterp(_,_,_) ->
- % on garde les uninterp pour check_sat_vars
- true
- ; kill_suspension(Susp)),
- functor(Goal,F,_),
- ((occurs(F,(isNaN,isNormal,isSubnormal,
- isInfinite,isFinite,isZero,
- isPositive,isNegative,
- uninterp,fp_eq1));
- (Goal = chk_nan_reif(_,_,_,CN);
- ((% not_int
- Goal = diff_int(V1,V2);
- % and_reif
- Goal = mult_int(V1,_,V2,_,V,_),
- var(V)),
- mfd:get_intervals(V1,[0,1]),
- mfd:get_intervals(V2,[0,1]))),
- (var(CN);CN == 0))
- ->
- true
- ; ((Goal = real_to_float_bis(Type,A,B),
- is_real_box(A))
- ->
- true
- ; % pas d'inegalite
- (occurs(F,(diff_real,gt_real,geq_real)) ->
- setval(real_unknown,1)@eclipse,
- fail
- ; true),
- term_variables(Goal,Vars),
- (foreach(V,Vars) do
- (is_real_box(V) ->
- true
- ; setval(real_unknown,1)@eclipse,
- fail))))))
+ getval(smt_status,Status)@eclipse,
+ block(
+ ((solve_cstrs,
+ suspensions(LSusp),
+ (foreach(Susp,LSusp) do
+ get_suspension_data(Susp,goal,Goal),
+ (Goal = uninterp(_,_,_,_,_,_) ->
+ % on garde les uninterp pour check_sat_vars
+ true
+ ; kill_suspension(Susp)),
+ functor(Goal,F,_),
+ ((occurs(F,(isNaN,isNormal,isSubnormal,
+ isInfinite,isFinite,isZero,
+ isPositive,isNegative,
+ uninterp,fp_eq1));
+ (Goal = chk_nan_reif(_,_,_,CN);
+ ((% not_int
+ Goal = diff_int(V1,V2);
+ % and_reif
+ Goal = mult_int(V1,_,V2,_,V,_),
+ var(V)),
+ mfd:get_intervals(V1,[0,1]),
+ mfd:get_intervals(V2,[0,1]))),
+ (var(CN);CN == 0))
+ ->
+ true
+ ; ((Goal = real_to_float_bis(Type,A,B),
+ is_real_box(A))
+ ->
+ true
+ ; % pas d'inegalite
+ (occurs(F,(diff_real,gt_real,geq_real)) ->
+ setval(real_unknown,1)@eclipse,
+ fail
+ ; true),
+ term_variables(Goal,Vars),
+ (foreach(V,Vars) do
+ (is_real_box(V) ->
+ true
+ ; setval(real_unknown,1)@eclipse,
+ fail))))))
->
- Diag0 = sat
- ; (((getval(real_unknown,1)@eclipse;
- getval(quantifier,1)) % SAT PAS FIABLE
- ->
- Diag = unknown,
- Code = 2
- ; Diag = unsat,
- Code = 0),
- setval(diag_code,(Diag,Code))@eclipse)),
+ (getval(quantifier,1) ->
+ UQA = 1,
+ Diag0 = unknown
+ ; UQA = 0,
+ Diag0 = sat),
+ setval(unknown_quantifier_abstraction,UQA)@eclipse
+ ; (getval(real_unknown,1)@eclipse ->
+ Diag = unknown,
+ Code = 2
+ ; (Status == sat ->
+ Diag = unknown,
+ Code = 2,
+ writeln(error,"wrong unsat")
+ ; Diag = unsat,
+ Code = 0)),
+ setval(diag_code,(Diag,Code))@eclipse),
Tag,
((Tag == timeout_col;
- Tag == timeout_ball_thrown)
- ->
+ Tag == timeout_ball_thrown)
+ ->
exit_block(timeout_col)
; Diag = unknown,
Code = 2,
setval(diag_code,(Diag,Code))@eclipse)),
- (Diag0 == sat ->
+ ((Diag0 == sat;
+ Diag0 == unknown,
+ getval(unknown_quantifier_abstraction,1)@eclipse)
+ ->
get_priority(Prio),
getval(use_delta,UD)@eclipse,
getval(use_simplex,US)@eclipse,
@@ -857,13 +641,15 @@ check_sat0 :-
no_delta,
no_simplex,
block((check_sat_vars ->
- true
+ (getval(unknown_quantifier_abstraction,1)@eclipse ->
+ setval(diag_code,(unknown,2))@eclipse
+ ; true)
; true),
Tag,
(set_priority(Prio),
setval(check_sat_vars,0)@eclipse,
setval(use_delta,UD)@eclipse,
- setval(use_simplex,US@eclipse),
+ setval(use_simplex,US)@eclipse,
exit_block(Tag))),
set_priority(Prio),
setval(check_sat_vars,0)@eclipse,
@@ -879,10 +665,11 @@ check_sat_vars :-
not not check_sat_vars0.
check_sat_vars0 :-
setval(diag_code,(wrong_sat,2))@eclipse,
- %suspensions(LS),
- %(foreach(S,LS) do kill_suspension(S)),
getval(gsat,Goals-GVars)@eclipse,
(foreach((V,Type,CV),GVars) do
+ (real_type(Type,_) ->
+ real_vars(Type,V)
+ ; int_vars(Type,V)),
(Type = array(_,_) ->
CV = V
; CV = as(V,Type))),
@@ -920,7 +707,7 @@ check_sat_vars0 :-
->
true
; ((% pas d'inegalite
- (occurs(F,(diff_real,gt_real,geq_real)) ->
+ (occurs(F,(diff_real,gt_real)) ->
setval(diag_code,(unknown,2))@eclipse,
fail
; true),
@@ -939,7 +726,8 @@ get_assignment :-
getval(use_simplex,US)@eclipse,
no_delta,
no_simplex,
- ((getval(diag_code,(_,1))@eclipse,
+ ((once (getval(diag_code,(_,1))@eclipse;
+ getval(unknown_quantifier_abstraction,1)@eclipse),
getval(binding,HNV)@eclipse,
HNV \== 0)
->
@@ -971,43 +759,73 @@ get_assignment :-
% apres un check-sat
get_model :-
+ (getval(diag_code,(_,1))@eclipse;
+ getval(unknown_quantifier_abstraction,1)@eclipse),
+ !,
getval(use_delta,UD)@eclipse,
getval(use_simplex,US)@eclipse,
no_delta,
no_simplex,
- ((getval(diag_code,(_,1))@eclipse,
- getval(binding,HNV),
+ ((getval(binding,HNV),
HNV \== 0)
->
hash_list(HNV,Ks,Vs),
(foreach(K,Ks),
- foreach((Type,V),Vs),
- foreach((Type,VV),VVs) do
+ foreach((Type0,V),Vs),
+ foreach((K,V),Vars) do
+ (real_type(Type0,Type) ->
+ true
+ ; Type = Type0),
((Type \= sort(_),
+ Type \== rnd,
Type \= array(_,_),
(var(V),VV = V;
remove_upper_as(V,VV,_),var(VV)))
->
functor(Type,FType,_),
(occurs(FType,(bool,int,uint)) ->
+ int_vars(Type,VV),
inst_type(int,VV)
- ; inst_type(FType,VV))
- ; ((nonvar(V),
- remove_upper_as(V,VV,_))
+ ; (is_real_box(VV) ->
+ true
+ ; real_vars(Type,VV),
+ inst_type(Type,VV)))
+ ; ((Type = array(_,_);
+ Type == rnd;
+ Type = sort(_))
->
- true
- ; VV = V,
- (Type = array(_,_) ->
- inst_type(Type,V)
- ; true)))),
- dump_smt_model(Ks,VVs)
+ inst_type(Type,V)
+ ; true))),
+ dump_smt_model(Vars)
; true),
setval(use_delta,UD)@eclipse,
setval(use_simplex,US)@eclipse.
+get_model.
+
+get_initial_variable_type(V,Type0,Type) :-
+ (get_variable_type(V,TypeI) ->
+ true
+ ; % constante real/float
+ TypeI = Type0),
+ get_initial_type(TypeI,Type).
+
+get_initial_type(bool,"Bool") :- !.
+get_initial_type(int,"Int") :- !.
+% pas de int(S) normalement
+get_initial_type(uint(S),BVs) ?- !,
+ concat_string(["(_ BitVec ",S,")"],BVs).
+get_initial_type(rnd,"RoundingMode") :- !.
+get_initial_type(real,"Real") :- !.
+get_initial_type(float_simple,"(_ FloatingPoint 8 24)") :- !.
+get_initial_type(float_double,"(_ FloatingPoint 11 53)") :- !.
+get_initial_type(array(TI,TE),SArray) ?- !,
+ dump_array_type('Array'(TI,TE),SArray).
+get_initial_type(sort(Sort),Sort) :- !.
% apres un check-sat
get_value(LExpr) :-
- getval(diag_code,(_,1))@eclipse,
+ (getval(diag_code,(_,1))@eclipse;
+ getval(unknown_quantifier_abstraction,1)@eclipse),
!,
getval(use_delta,UD)@eclipse,
getval(use_simplex,US)@eclipse,
@@ -1018,46 +836,70 @@ get_value(LExpr) :-
->
hash_list(KVs,Ks,Vs),
(foreach(K,Ks),
- foreach((Type,V),Vs) do
+ foreach((Type0,V),Vs) do
+ (real_type(Type0,Type) ->
+ true
+ ; Type = Type0),
((Type \= sort(_),
+ Type \== rnd,
Type \= array(_,_),
(var(V),VV = V;
remove_upper_as(V,VV,_),var(VV)))
->
functor(Type,FType,_),
(occurs(FType,(bool,int,uint)) ->
+ int_vars(Type,VV),
inst_type(int,VV)
; (is_real_box(VV) ->
true
- ; inst_type(FType,VV)))
- ; (Type = array(_,_) ->
+ ; real_vars(Type,VV),
+ inst_type(Type,VV)))
+ ; ((Type = array(_,_);
+ Type == rnd;
+ Type = sort(_))
+ ->
inst_type(Type,V)
; true))),
- (foreach((OExpr,Type,Expr),LExpr),
+ (foreach((OExpr,Type0,Expr),LExpr),
foreach(Var,Vars),
- foreach((Type,Res),Values) do
- build_sexpr(OExpr,Var),
+ foreach((OType,Res),Values) do
+ (real_type(Type0,Type) ->
+ true
+ ; Type = Type0),
+ (OExpr = as(NExpr,OType) ->
+ true
+ ; NExpr = Expr,
+ OType = Type),
+ remove_all_as(NExpr,NExpr1),
+ build_sexpr(NExpr1,Var0),
+ (var(OType) ->
+ true
+ ; build_sexpr(OType,SOType),
+ concat_string(["(as ",Var0," ",SOType,")"],Var)),
functor(Type,FType,_),
- (occurs(FType,(bool,int,uint,sort,array)) ->
+ (occurs(FType,(bool,int,uint,sort,rnd,array)) ->
IType = int,
int_vars(Type,Res),
as(Expr,Type) #= Res
; IType = Type,
- (Type == float_double ->
+ (IType == float_double ->
NType = double
- ; (Type == float_simple ->
+ ; (IType == float_simple ->
NType = float
- ; Type == real,
- NType = Type)),
- real_vars(NType,Res),
+ ; IType == real,
+ NType = IType)),
+ real_vars(Type,Res),
as(Expr,Type) $= Res),
((nonvar(Res);
- FType == sort;
+ %FType == sort;
FType == real,
is_real_box(Res))
->
true
- ; (FType == array ->
+ ; ((FType == array;
+ FType == sort;
+ FType == rnd)
+ ->
inst_type(Type,Res)
; inst_type(IType,Res)))),
dump_smt_binding(Vars,Values)
@@ -1066,33 +908,53 @@ get_value(LExpr) :-
setval(use_simplex,US)@eclipse.
get_value(_).
+remove_all_as(Atom,Atom) :-
+ atomic(Atom),
+ !.
+remove_all_as(as(T,_),NT) ?- !,
+ remove_all_as(T,NT).
+remove_all_as([],[]) :- !.
+remove_all_as([A|Args],[NA|NArgs]) :- !,
+ remove_all_as(A,NA),
+ remove_all_as(Args,NArgs).
+remove_all_as(T,NT) :-
+ T =.. [F|Args],
+ remove_all_as(Args,NArgs),
+ NT =.. [F|NArgs].
dump_smt_binding(Vars,Values) :-
set_flag(print_depth,1000),
write(output,"("),
(foreach(SVar,Vars),
- foreach((Type,Val0),Values) do
- dump_type_val(Type,Val0,Val1),
- ((Type == real,
- once append_strings(_,"Int)",SVar),
- term_string(RVal,Val1),
- number(RVal))
- ->
- integer(RVal,Val)
- ; Val = Val1),
+ foreach((OType,Val0),Values) do
+ dump_type_val(OType,Val0,Val),
write(output," ("),
write(output,SVar),
write(output," "),
- write(output,Val),
+ (Type == rnd ->
+ once member((Val,TVal),
+ [(rne,'RNE'),
+ (rna,'RNA'),
+ (rtn,'RTN'),
+ (rtp,'RTP'),
+ (rtz,'RTZ')])
+ ; TVal = Val),
+ write(output,TVal),
writeln(output,")")),
writeln(output,")").
-dump_type_val(bool,Val0,Val) ?- !,
+dump_type_val('Bool',Val0,Val) ?- !,
(Val0 == 1 ->
- Val = true
- ; Val = false).
-dump_type_val(real,Val0,Val) ?- !,
+ Val = "true"
+ ; Val = "false").
+dump_type_val('Int',Val0,Val) ?- !,
+ (float(Val0) ->
+ % simulation real/int
+ integer(Val0,Val1),
+ number_string(Val1,Val)
+ ; number_string(Val0,Val)).
+dump_type_val('Real',Val0,Val) ?- !,
(var(Val0) ->
(known_real_box(Val0,SNum,SDen) ->
(SDen == "1" ->
@@ -1101,88 +963,338 @@ dump_type_val(real,Val0,Val) ?- !,
; mreal:dvar_range(Val0,L,H),
rational(L,RL),
rational(H,RH),
- numerator(RL,NumL),
- denominator(RL,DenL),
+ protected_numerator(RL,NumL),
+ protected_denominator(RL,DenL),
(DenL == 1 ->
concat_string([NumL,".0"],SL)
; concat_string(["(/ ",NumL,".0 ",DenL,".0)"],SL)),
- numerator(RH,NumH),
- denominator(RH,DenH),
+ protected_numerator(RH,NumH),
+ protected_denominator(RH,DenH),
(DenH == 1 ->
concat_string([NumH,".0"],SH)
; concat_string(["(/ ",NumH,".0 ",DenH,".0)"],SH)),
concat_string(["(range ",SL," ",SH,")"], Val))
; rational(Val0,Val1),
- numerator(Val1,Num),
- denominator(Val1,Den),
+ protected_numerator(Val1,Num),
+ protected_denominator(Val1,Den),
(Den == 1 ->
concat_string([Num,".0"],Val)
; concat_string(["(/ ",Num,".0 ",Den,".0)"],Val))).
-dump_type_val(float_simple,Val0,Val) ?- !,
+dump_type_val('RoundingMode',Val0,Val) ?- !,
+ ((nonvar(Val0),
+ member((Val0,Val),
+ [(rne,'RNE'),
+ (rna,'RNA'),
+ (rtn,'RTN'),
+ (rtp,'RTP'),
+ (rtz,'RTZ')]))
+ ->
+ true
+ ; % rne par defaut
+ Val = 'RNE').
+dump_type_val('_'('FloatingPoint',8,24),Val0,Val) ?- !,
(Val0 == nan ->
concat_string(["(_ NaN ",8," ",24,")"],Val)
; get_raw_uint_from_float(float_simple,Val0,I),
concat_string(["((_ to_fp ",8," ",24,") (_ bv",I," ",32,"))"],Val)).
-dump_type_val(float_double,Val0,Val) ?- !,
+dump_type_val('_'('FloatingPoint',11,53),Val0,Val) ?- !,
(Val0 == nan ->
concat_string(["(_ NaN ",11," ",53,")"],Val)
; get_raw_uint_from_float(float_double,Val0,I),
concat_string(["((_ to_fp ",11," ",53,") (_ bv",I," ",64,"))"],Val)).
-dump_type_val(uint(Size),Val0,Val) ?- !,
+dump_type_val('_'('BitVec',Size),Val0,Val) ?- !,
concat_string(["(_ bv",Val0," ",Size,")"],Val).
-dump_type_val(array(TI,TE),Val,SVal) ?- !,
+dump_type_val('Array'(TI,TE),Val,SVal) ?- !,
dump_array(TI,TE,Val,SVal).
-% int ou sort
-dump_type_val(Type,Val,Val).
-
+% sorte composée ou non
+dump_type_val(OType,Val,SVal) :-
+ atom_string(Val,STVal),
+ term_string(TVal,STVal),
+ TVal =.. [':',Type,Cpt],
+ build_end_val_from_old_type(OType,SEndVal),
+ concat_string(["|val",Cpt,":",SEndVal,"|"],SVal).
+
+build_end_val_from_old_type([],[]) :- !.
+build_end_val_from_old_type([OType|OTypes],[NType|NTypes]) :- !,
+ build_end_val_from_old_type(OType,NType),
+ build_end_val_from_old_type(OTypes,NTypes).
+build_end_val_from_old_type(OType,NType) :-
+ (atom(OType) ->
+ atom_string(OType,NType)
+ ; OType =.. [F|OArgs],
+ build_end_val_from_old_type(OArgs,NArgs),
+ join_string(NArgs," ",SNargs),
+ concat_string(["(",F," ",SNargs,")"],NType)).
+
+dump_array(TI,TE,const_array(TII,TEE,Const),Str) ?- !,
+ dump_const_array(TI,TE,Const,Str).
+dump_array(TI,TE,storec(storec(A,I,v(_,E,_)),I,v(_,E,_)),Str) ?- !,
+ dump_array(TI,TE,storec(A,I,v(_,E,_)),Str).
dump_array(TI,TE,storec(A,I,v(_,E,_)),Str) ?- !,
- dump_array(TI,TE,A,SA),
- dump_type_val(TI,I,SI),
- dump_type_val(TE,E,SE),
- concat_string(["(store ",SA," ",SI," ",SE,")"],Str).
-dump_array(_,_,V,SV) :-
+ ((var(A),
+ ground(E))
+ ->
+ dump_const_array(TI,TE,E,Str)
+ ; dump_array(TI,TE,A,SA),
+ dump_type_val(TI,I,SI),
+ dump_type_val(TE,E,SE),
+ concat_string(["(store ",SA," ",SI," ",SE,")"],Str)).
+dump_array(TI,TE,V,SV) :-
% variable
- get_variable_atom(V,SV0),
- concat_string(["|",SV0,"|"],SV).
+ var(V),
+ dump_const_array(TI,TE,_DefE,SV).
+
+dump_array_type('Array'(TI,TE),SAT) :- !,
+ dump_array_type(TI,STI),
+ dump_array_type(TE,STE),
+ concat_string(["(Array ",STI," ",STE,")"],SAT).
+dump_array_type('_'('BitVec',Size),SType) :- !,
+ concat_string(["(_ BitVec ",Size,")"],SType).
+dump_array_type(Type,SType) :-
+ (atomic(Type) ->
+ SType = Type
+ ; term_string(Type,SType)).
+
+% SYNTAXE CVC4
+dump_const_array(TI,TE,DefE,S) :-
+ dump_array_type('Array'(TI,TE),SAT),
+ (ground(DefE) ->
+ dump_type_val(TE,DefE,SE)
+ ; (TE = 'Array'(TIE,TEE) ->
+ dump_const_array(TIE,TEE,_,SE)
+ ; array_const_elt(TE,SE))),
+ concat_string(["((as const ",SAT,") ",SE,")"],S).
+/*
+% SYNTAXE EXEMPLE SMTLIB STANDARD (je prefere !)
+% Comment parser ca avec dolmen ?
+dump_const_array(TI,TE,DefE,S) :-
+ dump_array_type('Array'(TI,TE),SAT),
+ (ground(DefE) ->
+ dump_type_val(TE,DefE,SE)
+ ; (TE = 'Array'(TIE,TEE) ->
+ dump_const_array(TIE,TEE,_,SE)
+ ; array_const_elt(TE,SE))),
+ concat_string(["(as (const-array ",SE,") ",SAT,")"],S).
+*/
+array_const_elt('Bool',"true") :- !.
+array_const_elt('Int',"0") :- !.
+array_const_elt('Real',"0.0") :- !.
+array_const_elt('_'('BitVec',Size),S) :- !,
+ concat_string(["(_ bv0 ",Size,")"],S).
+array_const_elt('_'('FloatingPoint',EB,SB),S) :- !,
+ (SB == 53 ->
+ Type = float_double,
+ Size = 64
+ ; Type = float_simple,
+ Size = 32),
+ get_raw_uint_from_float(Type,0.0,I),
+ concat_string(["((_ to_fp ",EB," ",SB,") (_ bv",I," ",Size,"))"],
+ S).
+array_const_elt('Array'(SI,SE),S) ?- !,
+ dump_const_array(SI,SE,_Def,S).
+array_const_elt(Sort,S) :-
+ get_sort_vals(Sort,[Val|Vals]),
+ dump_type_val(Sort,Val,S).
+
+dump_smt_model(Vars) :-
+ set_flag(print_depth,1000),
+ getval(sorts,HSorts),
+ getval(declared_funs,DFs-[]),
+ writeln(output,"(model"),
+ (HSorts == 0 ->
+ true
+ ; hash_list(HSorts,Ks,Vs),
+ (foreach(Sort,Ks),
+ foreach((Ar,SortVals),Vs) do
+ concat_string([" (declare-sort ",Sort," ",Ar,")"],Ds),
+ writeln(output,Ds))),
+ (foreach((VN,InSorts,OutSort),DFs),
+ fromto([],IU,OU,Uninterps),
+ fromto(Vars,InVars,OutVars,NVars) do
+ (InSorts == [] ->
+ (member_begin_end((VN,Val0),InVars,OutVars,End,End) ->
+ OU = IU,
+ dump_type_val(OutSort,Val0,Val),
+ dump_smt_sort(OutSort,SOutSort),
+ concat_string([" (define-fun ",VN," () ",SOutSort," ",Val,")"],Str),
+ writeln(output,Str)
+ ; OutVars = InVars,
+ OU = [(VN,InSorts,OutSort)|IU])
+ ; OutVars = InVars,
+ OU = [(VN,InSorts,OutSort)|IU])),
+ factorize_and_dump_uninterps(Uninterps),
+ writeln(output,")").
+dump_smt_sort(Sort,NSort) :-
+ (atomic(Sort) ->
+ NSort = Sort
+ ; Sort =.. [F|Args],
+ (foreach(Arg,Args),
+ foreach(NArg,NArgs) do
+ dump_smt_sort(Arg,NArg)),
+ join_string([F|NArgs]," ",NSort0),
+ concat_string(["(",NSort0,")"],NSort)).
+
+factorize_and_dump_uninterps([]).
+factorize_and_dump_uninterps([(VN,InSorts,OutSort)|Uninterps]) :-
+ (ground((InSorts,OutSort)) ->
+ (foreach(Sort,[OutSort|InSorts]),
+ foreach(ISort,[IOut|IIns]) do
+ get_type_from_sort(Sort,ISort,_)),
+ uninterp_trigger(VN,IIns,IOut,Trigger),
+ attached_suspensions(Trigger,LSusp),
+ (LSusp \== [] ->
+ findall((Ins,Out),
+ (member(Susp,LSusp),
+ get_suspension_data(Susp,goal,uninterp(VN,Trigger,_,_,Ins,Out)),
+ kill_suspension(Susp)),
+ Profiles),
+ (foreach(Is,InSorts),
+ foreach((SIV,SIs),NInSorts),
+ foreach(InSorted,InSorteds) do
+ dump_smt_sort(Is,SIs),
+ protected_set_var_name(IV,"ColVar"),
+ protected_get_var_name(IV,SIV),
+ concat_string(["(",SIV," ",SIs,")"],InSorted)),
+ join_string(InSorteds," ",InProf0),
+ concat_string(["(",InProf0,")"],InProf),
+ dump_smt_sort(OutSort,NOutSort),
+ dump_smt_uninterps(Profiles,NInSorts,OutSort,Def),
+ concat_string([" (define-fun ",VN," ",InProf," ",NOutSort," ",Def,")"],DF),
+ writeln(output,DF)
+ ; true)
+ ; concat_string([";; Warning: instanciations of polymorphic"
+ " function ",VN," are ignored."],Warn),
+ writeln(output,Warn)),
+ factorize_and_dump_uninterps(Uninterps).
+
+% Constante
+dump_smt_uninterps([],_,OutSort,Default) :-
+ ((get_type_from_sort(OutSort,Type,_),
+ Type = sort(_))
+ ->
+ get_sort_vals(OutSort,[Val|_]),
+ dump_type_val(OutSort,Val,Default)
+ ; array_const_elt(OutSort,Default)).
+dump_smt_uninterps([(Ins,Out)|Profiles],InSorts,OutSort,SUninterp) :-
+ % Variable possible ici et dans les Ins !!!
+ ((var(Out),
+ get_type_from_sort(OutSort,OutType0,_),
+ (OutType0 == real_int ->
+ OutType = real
+ ; OutType = OutType0))
+ ->
+ inst_type(OutType,Out)
+ ; true),
+ dump_type_val(OutSort,Out,SOut),
+ (Profiles = [] ->
+ % On a fini, on prend SOut sans ite
+ SUninterp = SOut
+ ; (foreach(In,Ins),
+ foreach((SV,IS),InSorts),
+ foreach(Eq,Eqs) do
+ (var(In) ->
+ ((functor(IS,FIS,Ar),
+ known_sort(FIS,Ar,_))
+ ->
+ NIS = sort(IS)
+ ; NIS = IS),
+ inst_type(NIS,In)
+ ; true),
+ dump_type_val(IS,In,SIn),
+ concat_string(["(= ",SV," ",SIn,")"],Eq)),
+ join_string(Eqs," ",SAE0),
+ (Ins = [_,_|_] ->
+ concat_string(["(and ",SAE0,")"],SAE)
+ ; SAE = SAE0),
+ (var(Out) ->
+ ((functor(OutSort,FO,Ar),
+ known_sort(FO,Ar,_))
+ ->
+ NOutSort = sort(OutSort)
+ ; NOutSort = OutSort),
+ inst_type(NOutSort,Out)
+ ; true),
+ dump_smt_uninterps(Profiles,InSorts,OutSort,NSUninterp),
+ (NSUninterp == SOut ->
+ SUninterp = SOut
+ ; concat_string(["(ite ",SAE," ",SOut," ",NSUninterp,")"],SUninterp))).
-dump_smt_model(Vars,Values) :-
- set_flag(print_depth,1000),
- (foreach(SVar,Vars),
- foreach((Type,Val0),Values) do
- dump_type_val(Type,Val0,Val),
- write(output," (assert (= |"),
- write(output,SVar),
- write(output,"| "),
- write(output,Val),
- writeln(output,"))")).
known_real_box(Box,SNum,SDen) :-
is_real_box_rat(Box,Rat),
term_string(Rat,SRat),
split_string(SRat,"_","",[SNum,SDen]).
-
-build_sexpr(bv(XB,Val),SExpr) ?- !,
- concat_string([#,XB,Val],SExpr).
+build_family_op_term(divisible,[N0,I],SExpr) ?- !,
+ remove_upper_as(N0,N,_),
+ build_sexpr(I,SI),
+ concat_string(["((_ divisible ",N,") ",SI,")"],SExpr).
+build_family_op_term(extract,[H,L,BV],SExpr) ?- !,
+ build_sexpr(BV,SBV),
+ concat_string(["((_ extract ",H," ",L,") ",SBV,")"],SExpr).
+build_family_op_term(ieee_to_fp,[E,M,Arg],SExpr) ?- !,
+ build_sexpr(Arg,NArg),
+ concat_string(["((_ to_fp ",E," ",M,") ",NArg,")"],SExpr).
+build_family_op_term(to_fp,[E,M|Args],SExpr) ?- !,
+ (foreach(Arg,Args),
+ foreach(NArg,NArgs) do
+ build_sexpr(Arg,NArg)),
+ join_string(NArgs," ",SNArgs),
+ concat_string(["((_ to_fp ",E," ",M,") ",SNArgs,")"],SExpr).
+build_family_op_term(to_fp_unsigned,[E,M|Args],SExpr) ?- !,
+ (foreach(Arg,Args),
+ foreach(NArg,NArgs) do
+ build_sexpr(Arg,NArg)),
+ join_string(NArgs," ",SNArgs),
+ concat_string(["((_ to_fp_unsigned ",E," ",M,") ",SNArgs,")"],SExpr).
+build_family_op_term('fp.to_ubv',[M|Args],SExpr) ?- !,
+ (foreach(Arg,Args),
+ foreach(NArg,NArgs) do
+ build_sexpr(Arg,NArg)),
+ join_string(NArgs," ",SNArgs),
+ concat_string(["((_ fp.to_ubv ",M,") ",SNArgs,")"],SExpr).
+build_family_op_term('fp.to_sbv',[M|Args],SExpr) ?- !,
+ (foreach(Arg,Args),
+ foreach(NArg,NArgs) do
+ build_sexpr(Arg,NArg)),
+ join_string(NArgs," ",SNArgs),
+ concat_string(["((_ fp.to_sbv ",M,") ",SNArgs,")"],SExpr).
+build_family_op_term(bv,[XB,Val],SExpr) ?- !,
+ get_int_from_bv(bv(XB,Val),Num,Size),
+ concat_string(["(_ bv",Num," ",Size,")"],SExpr).
+build_family_op_term(nat2bv,[Size,Val],SExpr) ?- !,
+ build_sexpr(Val,SVal),
+ concat_string(["((_ nat2bv ",Size,") ",SVal,")"],SExpr).
+build_family_op_term(int2bv,[Size,Val],SExpr) ?- !,
+ build_sexpr(Val,SVal),
+ concat_string(["((_ int2bv ",Size,") ",SVal,")"],SExpr).
+
+build_sexpr(roundNearestTiesToAway,"RNA") :- !.
+build_sexpr(roundNearestTiesToEven,"RNE") :- !.
+build_sexpr(roundTowardZero,"RTZ") :- !.
+build_sexpr(roundTowardNegative,"RTN") :- !.
+build_sexpr(roundTowardPositive,"RTP") :- !.
build_sexpr(realString(Str),SExpr) ?- !,
- number_string(SExpr,Str).
+ SExpr = Str.
build_sexpr(Term,SExpr) :-
compound(Term),!,
Term =.. [F|LArgs],
- ((LArgs = [Args],
- nonvar(Args),
- Args = [_|_])
- ->
+ (build_family_op_term(F,LArgs,SExpr) ->
true
- ; Args = LArgs),
- build_sexpr_args(Args,SArgs),
- (atom(F) ->
- SF = F
- ; term_string(F,SF)),
- join_string([SF|SArgs]," ",String),
- concat_string(["(",String,")"],SExpr).
+ ; ((LArgs = [Args],
+ nonvar(Args),
+ Args = [_|_])
+ ->
+ true
+ ; Args = LArgs),
+ build_sexpr_args(Args,SArgs),
+ (atomic(F) ->
+ SF = F
+ ; term_string(F,SF)),
+ join_string([SF|SArgs]," ",String),
+ concat_string(["(",String,")"],SExpr)).
build_sexpr(Atom,SExpr) :-
(number(Atom) ->
number_string(Atom,SExpr)
@@ -1203,6 +1315,10 @@ build_sexpr_args([Arg|Args],[SArg|SArgs]) :-
:- local reference(seen_expr).
:- local reference(sorts).
:- local reference(defined_funcs).
+:- local reference(declared_funs).
+
+
+
:- setval(in_let,0).
init_binding :-
@@ -1216,25 +1332,18 @@ init_binding :-
hash_create(HLVars),
setval(let_vars,HLVars),
setval(in_let,0),
- setval(quantifier,0).
+ setval(quantifier,0),
+ setval(declared_funs,E-E).
-define_smt_func(F,Args,Type,Expr) :-
- length(Args,Ar),
+define_smt_func(F,TypedArgs,Type,Expr) :-
+ length(TypedArgs,Ar),
getval(defined_funcs,Hfuncs),
- (hash_contains(Hfuncs,F/Ar) ->
- concat_string(["(error \"Already defined function:",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax)
- ; hash_set(Hfuncs,F/Ar,(Args,Type,Expr))).
+ hash_set(Hfuncs,F/Ar,(TypedArgs,Type,Expr)).
-define_smt_uifunc(F,Types,Type,RI) :-
+define_smt_uifunc(F,Ar,RI) :-
length(Types,Ar),
getval(defined_funcs,Hfuncs),
- (hash_contains(Hfuncs,F/Ar) ->
- concat_string(["(error \"Already defined function:",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax)
- ; hash_set(Hfuncs,F/Ar,(Types,Type:RI))).
+ hash_set(Hfuncs,F/Ar,RI).
defined_smt_func(F/Ar,IArgs,Type,IExpr) :-
@@ -1245,53 +1354,71 @@ defined_smt_func(F/Ar,IArgs,Type,IExpr) :-
writeln(error,Err),
exit_block(syntax)),
(Profile = (FArgs,FType,FIExpr) ->
- (FType = Type ->
- true
- ; concat_string(["(error \"Type mismatch in call to ",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax)),
- % on verifie les types en liant les parametres actuels/formels
+ % on lie les parametres actuels/formels
(foreach((IArg,IArgType),IArgs),
- foreach((FIArg,FArgType),FArgs),
- fromto(FIExpr,IE,OE,IExpr),
- param(F,Ar) do
- (IArgType = FArgType ->
- % On doit remplacer toutes les occurences de FIArg
- % par IArg
- findall(P,
- cgiveVarInstancePath(FIArg,IE,[],P),
- Paths),
- (foreach(P,Paths),
- fromto(IE,IIE,OOE,OE),
- param(IArg) do
- creplace_at_path_in_term(P,IIE,IArg,OOE))
- ; concat_string(["(error \"Argument type mismatch in call to ",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax)))
- ; Profile = (FTypes,FType:RI),
- (FType = Type ->
- true
- ; concat_string(["(error \"Type mismatch in call to ",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax)),
- % Symbole non-interprete
- % on verifie les types
+ foreach((FIArg,FIArgType),FArgs),
+ fromto(FIExpr,IE,OE,IExpr0) do
+ (FIArgType == IArgType ->
+ OE1 = IE
+ ; findall(ATP,
+ cgiveVarInstancePath(FIArgType,IE,[],ATP),
+ ATPaths),
+ (foreach(ATP,ATPaths),
+ fromto(IE,IE0,OE0,OE1),
+ param(IArgType) do
+ creplace_at_path_in_term(ATP,IE0,IArgType,OE0))),
+ % On doit remplacer toutes les occurences de FIArg par IArg
+ % sans faire une unification (pour les autres appels)
+ % Comme defined_funcs est une ref, on garde bien les
+ % variables globalles de FIExpr
+ findall(P,
+ cgiveVarInstancePath(FIArg,OE1,[],P),
+ Paths),
+ (foreach(P,Paths),
+ fromto(OE1,IIE,OOE,OE),
+ param(IArg) do
+ creplace_at_path_in_term(P,IIE,IArg,OOE)),
+ ((nonvar(IArgType),
+ IArgType = sort(Sort))
+ ->
+ % Peuplement des valeurs de Sort
+ new_sort_val(Sort)
+ ; true)),
+ (FType == Type ->
+ IExpr = IExpr0
+ ; findall(PT,
+ cgiveVarInstancePath(FType,IExpr0,[],PT),
+ TPaths),
+ (foreach(PT,TPaths),
+ fromto(IExpr0,NIIE,NOOE,IExpr),
+ param(Type) do
+ creplace_at_path_in_term(PT,NIIE,Type,NOOE)))
+ ; % Symbole non-interprete
(foreach((IArg,IArgType),IArgs),
- foreach(as(IArg,IArgType),NIArgs),
- foreach(AFType,FTypes),
- param(F,Ar) do
- (IArgType = AFType ->
- true
- ; concat_string(["(error \"Argument type mismatch in call to ",F,/,Ar,"\")"],Err),
- writeln(error,Err),
- exit_block(syntax))),
+ foreach(NIArg,NIArgs) do
+ ((nonvar(IArg),
+ IArg = as(_,_))
+ ->
+ NIArg = IArg
+ ; NIArg = as(IArg,IArgType)),
+ ((nonvar(IArgType),
+ IArgType = sort(Sort))
+ ->
+ % Peuplement des valeurs de Sort
+ new_sort_val(Sort)
+ ; true)),
Term =.. [F|NIArgs],
- (RI == real_int ->
+ (Profile == real_int ->
% simulation des entiers non bornes
- IExpr = as(setIntegral(uninterp(Term)),Type)
- ; IExpr = as(uninterp(Term),Type))).
-
-
+% IExpr = as(setIntegral(uninterp(Term)),Type)
+ IExpr = as(setIntegral(as(uninterp(Term),real_int)),real_int)
+ ; IExpr = as(uninterp(Term),Type))),
+ ((nonvar(Type),
+ Type = sort(RSort))
+ ->
+ % Peuplement des valeurs de RSort
+ new_sort_val(RSort)
+ ; true).
add_seen_expr(let(_,_),_,_) ?- !.
@@ -1329,42 +1456,74 @@ check_seen_expr(Expr,IExpr,Type) :-
known_sort(F,Ar,Sorts) :-
getval(sorts,HSorts),
HSorts \== 0,
- hash_get(HSorts,F,(Ar,Sorts,_)).
-add_sort(F,Ar,Sorts) :-
+ hash_get(HSorts,F,(Ar,SortVals)),
+ (member((Sorts,_,_),SortVals) ->
+ true
+ ; length(Sorts,Ar)).
+add_sort(F,Ar) :-
getval(sorts,HSorts0),
(HSorts0 == 0 ->
hash_create(HSorts),
setval(sorts,HSorts)
; HSorts = HSorts0),
- hash_set(HSorts,F,(Ar,Sorts,0,[])).
-new_sort_val(F,Ar) :-
+ hash_set(HSorts,F,(Ar,[])).
+new_sort_val(Sort) :-
getval(sorts,HSorts),
- hash_get(HSorts,F,(Ar,Sorts,Cpt,Vals)),
- concat_atom([F,'_',Cpt],Val),
+ functor(Sort,F,Ar),
+ hash_get(HSorts,F,(Ar,SortVals)),
+ Sort =.. [_|Sorts0],
+ remove_sort_func(Sorts0,Sorts),
+ ((member_begin_end((CSorts,Cpt,Vals),SortVals,NSortVals,PEnd,End),
+ CSorts == Sorts)
+ ->
+ PEnd = [(Sorts,NCpt,[Val|Vals])|End]
+ ; Cpt = 0,
+ NSortVals = [(Sorts,NCpt,[Val])|SortVals]),
+ SortTerm =.. [F|Sorts],
+ term_string(SortTerm:Cpt,SVal),
+ atom_string(Val,SVal),
NCpt is Cpt + 1,
- hash_set(HSorts,F,(Ar,Sorts,NCpt,[Val|Vals])).
-
-new_index_elem_val(sort(F),Var) ?- !,
- ((atom(Var),get_binding(Var,_,_);
+ hash_set(HSorts,F,(Ar,NSortVals)).
+
+
+remove_sort_func([],[]) :- !.
+remove_sort_func([Sort|Sorts],[NSort|NSorts]) :- !,
+ remove_sort_func(Sort,NSort),
+ remove_sort_func(Sorts,NSorts).
+remove_sort_func(Sort,NSort) :-
+ Sort =.. [F|Sorts],
+ (F == sort ->
+ Sorts = [Sort0],
+ remove_sort_func(Sort0,NSort)
+ ; remove_sort_func(Sorts,NSorts),
+ NSort =.. [F|NSorts]).
+
+new_index_elem_val(sort(Sort),Var) ?- !,
+ ((atomic(Var),get_binding(Var,_,_);
nonvar(Var),Var = select(_,_))
->
+ % cas déjà traités
true
- ; new_sort_val(F,0)).
+ ; new_sort_val(Sort)).
new_index_elem_val(_,_).
-
-get_sort_vals(F,Ar,Vals) :-
+get_sort_vals(Sort,Vals) :-
getval(sorts,HSorts),
- hash_get(HSorts,F,(Ar,Sorts,_,Vals)).
+ functor(Sort,F,Ar),
+ Sort =.. [_|Sorts0],
+ remove_sort_func(Sorts0,Sorts),
+ hash_get(HSorts,F,(Ar,SortVals)),
+ once (member((CSorts,_,Vals),SortVals),
+ CSorts == Sorts).
add_binding(Var,Type,Val) :-
getval(binding,HBinding),
(hash_contains(HBinding,Var) ->
true
; ((var(Val),
- not get_var_name(Val,_))
+ not protected_get_var_name(Val,_))
->
- set_var_name(Val,"ColVar")
+ protected_set_var_name(Val,"ColVar")
; true),
hash_set(HBinding,Var,(Type,Val))).
@@ -1378,9 +1537,9 @@ add_label(Label,Type,Val) :-
(hash_contains(HBinding,Label) ->
true
; ((var(Val),
- not get_var_name(Val,_))
+ not protected_get_var_name(Val,_))
->
- set_var_name(Val,"ColVar")
+ protected_set_var_name(Val,"ColVar")
; true),
hash_set(HBinding,Label,(Type,Val))),
getval(labels,Labels-End),
@@ -1407,7 +1566,7 @@ remove_let_var(Var) :-
setval(let_vars,HLV).
get_let_var_type(Var,NVar,Type) :-
- atom(Var),
+ atomic(Var),
getval(let_vars,HLV),
hash_get(HLV,Var,(Type,NVar)).
@@ -1446,7 +1605,51 @@ match_isObvious_tests(['fp.isNormal'(Arg),
Res) ?- !,
Res = Arg.
+% Inhibé car trop lent !!!
+try_factorize_in_let(Expr,Expr) :- !.
+try_factorize_in_let(Expr,NExpr) :-
+ (cgiveInstancePath(let(_,_),Expr,_) ->
+ % a priori déjà fait
+ NExpr = Expr
+ ; try_factorize_in_let1(Expr,NExpr)).
+
+try_factorize_in_let1(Expr,NExpr) :-
+ (find_mult_occ_compound_subterm(Expr,ST,LP) ->
+ %call(spy_here)@eclipse,
+ new_let_var(VId),
+ (ST = as(_,Type) ->
+ TVId = as(VId,Type)
+ ; TVId = VId),
+ (foreach(P,LP),
+ fromto(Expr,IE,OE,Expr1),
+ param(TVId) do
+ creplace_at_path_in_term(P,IE,TVId,OE)),
+ NExpr = let([(VId,ST)],NExpr1),
+ try_factorize_in_let1(Expr1,NExpr1)
+ ; NExpr = Expr).
+
+find_mult_occ_compound_subterm(Expr,ST,LP) :-
+ my_subterm(Expr,ST),
+ compound(ST),
+ (ST = as(SST,_) ->
+ compound(SST)
+ ; SST = ST),
+ functor(SST,FST,_),
+ FST \== 'Array',
+ FST \== '.',
+ (FST == '_' ->
+ arg(1,SST,T),
+ not member(T,['BitVec','FloatingPoint'])
+ ; true),
+ findall(P,cgiveInstancePath(ST,Expr,P),LP),
+ LP = [_,_|_].
+new_let_var(VId) :-
+ % Pas de collision possible avec les id smt_lib
+ protected_set_var_name(V,"ColId"),
+ protected_get_var_name(V,SVId),
+ concat_string(["\"",SVId,"\""],Str),
+ atom_string(VId,Str).
smt_interp(Expr,IExpr,Type) :-
(check_seen_expr(Expr,IExpr,Type) ->
@@ -1454,10 +1657,11 @@ smt_interp(Expr,IExpr,Type) :-
; smt_interp0(Expr,IExpr,Type),
add_seen_expr(Expr,IExpr,Type)).
-
+:- setval(logic,"ALL")@eclipse.
% INTERPRETATION
smt_interp0(exit,true,bool) :- !.
-smt_interp0('set-logic'(Logic),true,bool) :- !.
+smt_interp0('set-logic'(SLogic),true,bool) :- !,
+ setval(logic,SLogic)@eclipse.
smt_interp0('get-info'(Key),get_info(Key),bool) :- !.
smt_interp0('set-info'(K,S),true,bool) :- !,
@@ -1497,20 +1701,17 @@ smt_interp0(set_default_int_bounds(L,H),set_default_int_bounds(Low,High),bool)
setval(real_for_int,0)@eclipse
; unsupported_error("set_default_int_bounds needs min/max integer values")).
-% Pour le debug
-smt_interp0(spy_here,call(spy_here)@eclipse,bool) :- !.
-smt_interp0(assert(A0),NDecl,bool) :- !,
+smt_interp0(assert(A0),NewDecl,bool) :- !,
getval(decl,OD),
setval(decl,End-End),
reset_let_vars,
- % spy_here,
remove_upper_as(A0,A,_),
((nonvar(A),
A = '='([L0,R0]),
remove_upper_as(L0,L,_),
remove_upper_as(R0,R,_),
- (atom(L),Var = L,Def = R;
- atom(R),Var = R,Def = L),
+ (atomic(L),Var = L,Def = R;
+ atomic(R),Var = R,Def = L),
nonvar(Def),
(Def = store(_,_,_),Term = array_def(Var,Def);
Def = select(Array,Index),Term = array_elt_def(Array,Index,Var)))
@@ -1545,8 +1746,19 @@ smt_interp0(assert(A0),NDecl,bool) :- !,
; NEnd = IA),
(integer(Decl) ->
NDecl = as(Decl,bool)
- ; NDecl = Decl)),
+ ; ((Decl =.. [FD,X,Y],
+ occurs(FD,('#=','$=')),
+ remove_upper_as(X,X1,_),
+ remove_upper_as(Y,Y1,_),
+ (var(X1);atomic(X1)),
+ (var(Y1);atomic(Y1)))
+ ->
+ (protected_unify(X1,Y1) ->
+ NDecl = as(1,bool)
+ ; NDecl = as(0,bool))
+ ; NDecl = Decl))),
reset_let_vars,
+ remove_true_decl(NDecl,NewDecl),
setval(decl,OD).
smt_interp0(array_def(Var,Def),array_def(IVar,IDef),bool) :- !,
smt_interp(Var,IVar,Type),
@@ -1567,7 +1779,7 @@ smt_interp0('get-unsat-core',_,_) :- !,
unsupported_error("get-unsat-core").
smt_interp0('get-proof',_,_) :- !,
unsupported_error("get-proof").
-smt_interp0('get-model',get_model,int) :- !.
+smt_interp0('get-model',get_model,bool) :- !.
%smt_interp0('get-model',_,_) :- !,
% unsupported_error("get-model").
smt_interp0('get-unsat-assumptions',_,_) :- !,
@@ -1592,23 +1804,23 @@ smt_interp0('declare-sort'(F,Ar),true,bool) :- !,
(known_sort(F,Ar,_) ->
concat_string(["Already declared/defined sort ",F,"/",Ar],Mess),
unsupported_error(Mess)
- ; add_sort(F,Ar,[]))
- ; concat_string(["Wrong arity for sort ",F],Mess),
- writeln(output,Mess),
+ ; add_sort(F,Ar),
+ new_sort_val(F))
+ ; concat_string(["Unsupported arity for sort ",F],Mess),
+ writeln(error,Mess),
exit_block(syntax)).
smt_interp0('define-sort'(F,Sorts,Def),true,bool) :- !,
length(Sorts,Ar),
(known_sort(F,Ar,_) ->
concat_string(["Already declared/defined sort ",F,"/",Ar],Mess),
- writeln(output,Mess),
+ writeln(error,Mess),
exit_block(syntax)
; (foreach(S,Sorts) do
(known_sort(S,_,_) ->
true
; concat_string(["Undeclared/undefined sort argument in sort",F],Mess),
- writeln(output,Mess),
+ writeln(error,Mess),
exit_block(syntax))),
- % add_sort(F,Ar,Sorts),
(Ar == 0 ->
% alias de sort, on reutilise declare-var
smt_interp0('declare-var'(F,Def),Decl0,bool),
@@ -1616,14 +1828,15 @@ smt_interp0('define-sort'(F,Sorts,Def),true,bool) :- !,
Val = Type
; unsupported_error("define-sort"))).
+smt_interp0('define-poly-fun'(F,TypedVars,Sort,Expr),Decl,bool) :- !,
+ % A mettre en declare-poly-fun si pbs !!!!
+ smt_interp0('define-fun'(F,TypedVars,Sort,Expr),Decl,bool).
smt_interp0('define-fun'(F,TypedVars,Sort,Expr),Decl,bool) :- !,
-
((TypedVars == [],
- (Sort = 'Array'(_,_);
- getval(inline_def,0)))
+ (Sort = 'Array'(_,_)
+ ;getval(inline_def,0))
+ )
->
-
-% (TypedVars == [] ->
% On cree une fonction constante
smt_interp('define-const'(F,Sort,Expr),Decl0,bool),
(Decl0 == true ->
@@ -1646,25 +1859,25 @@ smt_interp0('define-fun'(F,TypedVars,Sort,Expr),Decl,bool) :- !,
->
(match_isFinite(Expr,Arg) ->
smt_interp(Arg,IArg,VType),
- %add_as(VType,IArg0,IArg),
IExpr = isFinite(IArg)
; (match_isObvious(Expr,Arg) ->
smt_interp(Arg,IArg,VType),
- %add_as(VType,IArg0,IArg),
IExpr = isFinite(IArg) and neg(isSubnormal(IArg))
- ; smt_interp(Expr,IExpr,Type)))
- ; smt_interp(Expr,IExpr,Type)),
+ ; try_factorize_in_let(Expr,NExpr),
+ smt_interp(NExpr,IExpr,Type)))
+ ; try_factorize_in_let(Expr,NExpr),
+ smt_interp(NExpr,IExpr,Type)),
setval(seen_expr,OSE),
reset_let_vars,
Decl = true,
check_eval(Type,IExpr,Res),
((TypedArgs == [],
+ ground(Type),
ground(Res))
->
add_binding(F,Type,Res)
; define_smt_func(F,TypedArgs,Type,IExpr))).
-
smt_interp0('define-const'(F,Sort,Expr),Decl,bool) :- !,
reset_let_vars,
smt_interp0('declare-var'(F,Sort),Decl0,bool),
@@ -1678,21 +1891,28 @@ smt_interp0('define-const'(F,Sort,Expr),Decl,bool) :- !,
Val = IExpr,
Decl = true
; (real_type(Type,_) ->
- Decl = (Decl0,Val $= IExpr)
- ; Decl = (Decl0,Val #= IExpr))),
+ Decl = (Decl0,as(Val,Type) $= IExpr)
+ ; Decl = (Decl0,as(Val,Type) #= IExpr))),
reset_let_vars.
smt_interp0('declare-const'(Id,Sort),Decl,bool) :- !,
smt_interp0('declare-var'(Id,Sort),Decl,bool).
+smt_interp0('declare-poly-fun'(Id,Sorts,Sort),Decl,bool) :- !,
+ % smt_interp0('declare-fun'(Id,Sorts,Sort),Decl,bool).
+ get_type_from_sort(Sort,_Type,RI),
+ (foreach(SId,Sorts),
+ foreach(VType,Types) do
+ get_type_from_sort(SId,VType,_)),
+ Decl = true,
+ length(Sorts,Ar),
+ define_smt_uifunc(Id,Ar,RI).
+
smt_interp0('declare-fun'(Id,Sorts,Sort),Decl,bool) :- !,
- % On cree une variable
(Sorts \== [] ->
- get_type_from_sort(Sort,Type,RI),
- (foreach(SId,Sorts),
- foreach(VType,Types) do
- get_type_from_sort(SId,VType,_)),
+ get_type_from_sort(Sort,_Type,RI),
Decl = true,
- define_smt_uifunc(Id,Types,Type,RI)
+ length(Sorts,Ar),
+ define_smt_uifunc(Id,Ar,RI)
; % On cree une variable
smt_interp0('declare-var'(Id,Sort),Decl,bool)).
smt_interp0('declare-fun-rec'(Id,Sorts,Sort),Decl,bool) :- !,
@@ -1705,7 +1925,7 @@ smt_interp0('declare-var'(Id,Sort),Decl,bool) :- !,
get_decl_type_from_sort(Sort,NVar,Decl,Type),
add_binding(Id,Type,NVar),
(known_sort(Sort,0,_) ->
- new_sort_val(Sort,0)
+ new_sort_val(Sort)
; true).
smt_interp0('!'(Expr,':named',F),Var,Type) :- !,
smt_interp(Expr,Val,Type),
@@ -1772,24 +1992,34 @@ smt_interp0(A,IA,Type) :-
number(A),
!,
(nonvar(Type) ->
- (Type == real ->
+ (occurs(Type,(real,real_int)) ->
(integer(A) ->
rational(A,RA),
term_string(RA,SRA),
- IA = realString(SRA)
+% IA = realString(SRA)
+ IA = as(realString(SRA),real_int)
; float(A), %??
IA = as(A,real))
; Type == int,
integer(A),
IA = A)
- ; % le type sera resolu plus tard
- IA = A).
+ ; (integer(A) ->
+ (getval(real_for_int,1)@eclipse ->
+ Type = real_int,
+ rational(A,RA),
+ term_string(RA,SRA),
+% IA = realString(SRA)
+ IA = as(realString(SRA),real_int)
+ ; Type = int,
+ IA = A)
+ ; % le type sera resolu plus tard
+ IA = A)).
smt_interp0('_'(FCst,EB,SB),as(Val,Type),Type) :- !,
fp_cst(FCst,EB,SB,Val,Type).
smt_interp0(true,as(1,bool),bool) :- !.
smt_interp0(false,as(0,bool),bool) :- !.
smt_interp0(Atom,IAtom,Type) :-
- atom(Atom),
+ atomic(Atom),
!,
(get_let_var_type(Atom,Val,Type) ->
true
@@ -1835,6 +2065,7 @@ smt_interp0(A xor B,IA xor IB,bool) :- !,
smt_interp0(A => B,IA => IB,bool) :- !,
smt_interp(A,IA,bool),
smt_interp(B,IB,bool).
+% comparaisons
smt_interp0(A < B,Comp,bool) :- !,
smt_interp(A,IA0,Type),
smt_interp(B,IB,Type),
@@ -1854,23 +2085,9 @@ smt_interp0(A <= B,Comp,bool) :- !,
Comp = (IA #=< IB)
; Comp = (IA $=< IB)).
smt_interp0(A > B,Comp,bool) :- !,
- smt_interp(A,IA0,Type),
- smt_interp(B,IB,Type),
- get_real_int_type_from_logic(Type),
- add_as(Type,IA0,IA),
- functor(Type,FType,_),
- (occurs(FType,(bool,int,uint)) ->
- Comp = (IA #> IB)
- ; Comp = (IA $> IB)).
+ smt_interp0(B < A,Comp,bool).
smt_interp0(A >= B,Comp,bool) :- !,
- smt_interp(A,IA0,Type),
- smt_interp(B,IB,Type),
- get_real_int_type_from_logic(Type),
- add_as(Type,IA0,IA),
- functor(Type,FType,_),
- (occurs(FType,(bool,int,uint)) ->
- Comp = (IA #>= IB)
- ; Comp = (IA $>= IB)).
+ smt_interp0(B <= A,Comp,bool).
smt_interp0(ite(A,B,C),R,Type) :- !,
@@ -1892,9 +2109,11 @@ smt_interp0(ite(A,B,C),R,Type) :- !,
smt_interp0(A = B,Eq,bool) :- !,
smt_interp(A,IA0,Type),
smt_interp(B,IB,Type),
+/*
(var(Type) ->
Type = int
; true),
+*/
add_as(Type,IA0,IA),
((A == B, VA = VB;
((number(IA0),VA = IA0;
@@ -1906,83 +2125,92 @@ smt_interp0(A = B,Eq,bool) :- !,
Eq = as(1,bool)
; Eq = as(0,bool))
; ((real_type(Type,_);
- Type = sort(S);
- Type = array(TI,TE))
+ nonvar(Type),
+ (Type = sort(S);
+ Type = array(TI,TE)))
->
- ((nonvar(S),
- not atom(A))
- ->
- new_sort_val(S,0)
+ (Type = array(_,_) ->
+ setval(keep_deltas_if_arrays,1)@eclipse
+ ; true),
+ (nonvar(S) ->
+ % on peut avoir besoin de deux valeurs
+ (atomic(A) ->
+ true
+ ; new_sort_val(S)),
+ (atomic(B) ->
+ true
+ ; new_sort_val(S))
; % on peut avoir besoin de 1 index et deux valeurs
(nonvar(TI) ->
((TI = sort(SI),
- not atom(A))
+ not atomic(A))
->
- new_sort_val(SI,0)
+ new_sort_val(SI)
; true),
((TE = sort(SE),
- not atom(B))
+ not atomic(B))
->
- new_sort_val(SE,0),
- new_sort_val(SE,0)
+ new_sort_val(SE),
+ new_sort_val(SE)
; true)
; true)),
Eq = neg(alldiff(Type,[IA,IB]))
- ; Eq = (IA #= IB))).
+ ; (var(Type) ->
+ Eq = neg(alldiff(Type,[IA,IB]))
+ ; Eq = (IA #= IB)))).
smt_interp0(distinct(L),Diff,bool) :- !,
(foreach(A,L),
foreach(IA,NL),
param(Type) do
smt_interp(A,IA,Type)),
(var(Type) ->
- Type = int
- ; true),
+ % constantes décimales !
+ fail
+ ; (Type = array(_,_) ->
+ setval(keep_deltas_if_arrays,1)@eclipse
+ ; true)),
((real_type(Type,_);
NL = [_,_,_|_];
Type = sort(S);
Type = array(TI,TE))
->
- (fail,nonvar(S) ->
- length(NL,Len),
- % Len distinct donc (Len*Len-1)/2
- NbVals is (Len*Len-1)//2,
- (for(I,1,NbVals),
+ % pour chaque diff on peut avoir besoin
+ % de 1 index et deux valeurs
+ ((nonvar(TI),
+ TI = sort(SI))
+ ->
+ new_sort_val(SI)
+ ; true),
+ ((nonvar(TE),
+ TE = sort(SE))
+ ->
+ new_sort_val(SE),
+ new_sort_val(SE)
+ ; true),
+ (nonvar(S) ->
+ (foreach(Elem,NL),
param(S) do
- new_sort_val(S,0))
- ; % pour chaque diff on peut avoir besoin
- % de 1 index et deux valeurs
- ((nonvar(TI),
- TI = sort(SI))
- ->
- new_sort_val(SI,0)
- ; true),
- ((nonvar(TE),
- TE = sort(SE))
- ->
- new_sort_val(SE,0),
- new_sort_val(SE,0)
- ; true)),
+ (atomic(Elem) ->
+ true
+ ; new_sort_val(S)))
+ ; true),
Diff = alldiff(Type,NL)
; NL = [IA0,IB],
- (Type = array(TI,TE) ->
- (TI = sort(SI) ->
- new_sort_val(SI,0)
- ; true),
- (TE = sort(SE) ->
- new_sort_val(SE,0),
- new_sort_val(SE,0)
- ; true)
- ; true),
add_as(Type,IA0,IA),
Diff = (IA #\= IB)).
-smt_interp0(divisible(A,N),Eq,bool) ?-
+smt_interp0(divisible(N0,A),Eq,bool) ?-
+ remove_upper_as(N0,N,_),
integer(N),
smt_interp(A,IA0,Type),
add_as(Type,IA0,IA),
+ (var(Type) ->
+ (getval(real_for_int,1) ->
+ Type = real_int
+ ; Type = int)
+ ; true),
(Type == int ->
Eq = (IA rem N #= 0)
- ; Type == real,
- Eq = (irmod(IA,real_from_int(N)) #= 0)).
+ ; Eq = (irmod(IA,real_from_int(N)) $= 0.0)).
smt_interp0(-A,Iop,Type) ?-
@@ -1993,7 +2221,7 @@ smt_interp0(-A,Iop,Type) ?-
; NA = A),
!,
smt_interp(NA,IA0,Type),
- ((Type == real,
+ ((occurs(Type,(real,real_int)),
check_rat_expr(-,0,IA0,Rat))
->
term_string(Rat,SRat),
@@ -2002,7 +2230,7 @@ smt_interp0(-A,Iop,Type) ?-
Iop = -IA).
smt_interp0(abs(A),Iabs,Type) :- !,
smt_interp(A,IA0,Type),
- ((Type == real,
+ ((occurs(Type,(real,real_int)),
check_rat_arg(IA0,Rat))
->
abs(Rat,AbsRat),
@@ -2013,7 +2241,7 @@ smt_interp0(abs(A),Iabs,Type) :- !,
smt_interp0(A + B,Iadd,Type) :- !,
smt_interp(A,IA0,Type),
smt_interp(B,IB,Type),
- ((Type == real,
+ ((occurs(Type,(real,real_int)),
check_rat_expr(+,IA0,IB,Rat))
->
term_string(Rat,SRat),
@@ -2023,7 +2251,7 @@ smt_interp0(A + B,Iadd,Type) :- !,
smt_interp0(A - B,Iminus,Type) :- !,
smt_interp(A,IA0,Type),
smt_interp(B,IB,Type),
- ((Type == real,
+ ((occurs(Type,(real,real_int)),
check_rat_expr(-,IA0,IB,Rat))
->
term_string(Rat,SRat),
@@ -2033,7 +2261,7 @@ smt_interp0(A - B,Iminus,Type) :- !,
smt_interp0(A * B,Imul,Type) :- !,
smt_interp(A,IA0,Type),
smt_interp(B,IB,Type),
- ((Type == real,
+ ((occurs(Type,(real,real_int)),
check_rat_expr(*,IA0,IB,Rat))
->
term_string(Rat,SRat),
@@ -2044,28 +2272,20 @@ smt_interp0(A div B,Idiv,Type) :- !,
smt_interp(A,IA0,Type),
add_as(Type,IA0,IA),
smt_interp(B,IB,Type),
+ get_real_int_type_from_logic(Type),
(Type == int ->
Idiv = (IA div IB)
- ; Type = real,
+ ; %Type = real,
Idiv = irdiv(IA,IB)).
smt_interp0(A mod B,Imod,Type) :- !,
smt_interp(A,IA0,Type),
add_as(Type,IA0,IA),
smt_interp(B,IB,Type),
+ get_real_int_type_from_logic(Type),
(Type == int ->
Imod = (IA mod IB)
- ; Type == real,
+ ; %Type = real,
Imod = irmod(IA,IB)).
-smt_interp0(colibri_cdiv(A,B),Idiv,int) :- !,
- smt_interp(A,IA0,int),
- add_as(int,IA0,IA),
- smt_interp(B,IB,int),
- Idiv = (IA // IB).
-smt_interp0(colibri_crem(A,B),Imod,int) :- !,
- smt_interp(A,IA0,int),
- add_as(int,IA0,IA),
- smt_interp(B,IB,int),
- Imod = (IA rem IB).
smt_interp0(A / B,Idiv,real) :- !,
smt_interp(A,IA0,real),
smt_interp(B,IB,real),
@@ -2075,27 +2295,45 @@ smt_interp0(A / B,Idiv,real) :- !,
; add_as(real,IA0,IA),
Idiv = IA / IB).
-% demande ADACORE
+
+% Pour le debug
+smt_interp0(spy_here,call(spy_here)@eclipse,bool) :- !.
+% demandes ADACORE
smt_interp0(to_int(A),IIA,Type) :- !,
smt_interp(A,IA0,real),
add_as(real,IA0,IA),
(getval(real_for_int,1)@eclipse ->
- Type = real,
+% Type = real,
+ Type = real_int,
IIA = floor(IA)
; Type = int,
IIA = int_from_real(floor(IA))).
-% demande ADACORE
smt_interp0(to_real(A),RIA,real) :- !,
(getval(real_for_int,1)@eclipse ->
- smt_interp(A,IA0,real),
- add_as(real,IA0,RIA)
+ smt_interp(A,IA0,real_int),
+ add_as(real_int,IA0,RIA)
; RIA = real_from_int(IA),
smt_interp(A,IA0,int),
add_as(int,IA0,IA)).
-% demande ADACORE
smt_interp0(is_int(A),IA,bool) :- !,
smt_interp0(colibri_isIntegral(A),IA,bool).
-
+% COLIBRI builtins
+smt_interp0(colibri_cdiv(A,B),Idiv,RIT) :- !,
+ smt_interp(A,IA0,RIT),
+ add_as(RIT,IA0,IA),
+ smt_interp(B,IB,RIT),
+ (getval(real_for_int,1)@eclipse ->
+% Idiv = real_from_int(int_from_real(IA) // int_from_real(IB))
+ Idiv = colibri_cdiv(IA,IB)
+ ; Idiv = (IA // IB)).
+smt_interp0(colibri_crem(A,B),Imod,RIT) :- !,
+ smt_interp(A,IA0,RIT),
+ add_as(RIT,IA0,IA),
+ smt_interp(B,IB,RIT),
+ (getval(real_for_int,1)@eclipse ->
+% Imod = real_from_int(int_from_real(IA) rem int_from_real(IB))
+ Imod = colibri_crem(IA,IB)
+ ; Imod = (IA rem IB)).
smt_interp0(colibri_floor(A),floor(IA),real) :- !,
smt_interp(A,IA0,real),
add_as(real,IA0,IA).
@@ -2110,13 +2348,11 @@ smt_interp0(colibri_round(A),round(IA),real) :- !,
add_as(real,IA0,IA).
smt_interp0(colibri_abs_int(A),AIA,Type) :- !,
(getval(real_for_int,1)@eclipse ->
- Type = real
+ Type = real_int
; Type = int),
smt_interp(A,IA0,Type),
add_as(Type,IA0,IA),
- (Type == real ->
- AIA = abs_real(IA)
- ; AIA = abs(IA)).
+ AIA = abs(IA).
smt_interp0(colibri_abs_real(A),IA,real) :- !,
smt_interp(abs(A),IA0,real),
add_as(real,IA0,IA).
@@ -2124,22 +2360,16 @@ smt_interp0(colibri_pow_real_int(A,B),IA ^ IB,real) :- !,
smt_interp(A,IA0,real),
add_as(real,IA0,IA),
(getval(real_for_int,1)@eclipse ->
- % on veut un int
- setval(real_for_int,0)@eclipse,
- smt_interp(B,IB,int),
- setval(real_for_int,1)@eclipse
+ smt_interp(B,IB0,real_int),
+ IB = int_from_real(IB0)
; smt_interp(B,IB,int)).
smt_interp0(colibri_pow_int_int(A,B),IA ^ IB,Type) :- !,
- smt_interp(A,IA0,int),
- add_as(int,IA0,IA),
(getval(real_for_int,1)@eclipse ->
- Type = real,
- smt_interp(A,IA0,real),
- add_as(real,IA0,IA),
- % on veut un int
- setval(real_for_int,0)@eclipse,
- smt_interp(B,IB,int),
- setval(real_for_int,1)@eclipse
+ Type = real_int,
+ smt_interp(A,IA0,Type),
+ add_as(Type,IA0,IA),
+ smt_interp(B,IB0,Type),
+ IB = int_from_real(IB0)
; Type = int,
smt_interp(A,IA0,int),
add_as(int,IA0,IA),
@@ -2152,6 +2382,7 @@ smt_interp0(colibri_min(A,B),min(IA,IB),Type) :- !,
smt_interp(A,IA0,Type),
add_as(Type,IA0,IA),
smt_interp(B,IB,Type).
+% real/float/double
smt_interp0(colibri_exp(A),Exp,Type) :-
smt_interp(A,IA0,Type0),
real_type(Type0,Type),
@@ -2180,8 +2411,40 @@ smt_interp0(colibri_setIntegral(A),Exp,real) :-
!,
add_as(real,IA0,IA),
Exp = setIntegral(IA).
+% Utilisés pour définition semantique et aussi par AdaCore
+smt_interp0('bv2int'(BV),RES,Type) :- !,
+ smt_interp0('bv2nat'(BV),RES,Type).
+smt_interp0('bv2nat'(BV),RES,Type) :- !,
+ smt_interp(BV,IBV,TBV),
+ TBV=uint(SIZE),
+ (getval(real_for_int,1)@eclipse ->
+ RES = real_from_int(int_from_uintN(SIZE,IBV))
+ ; RES= int_from_uintN(SIZE,IBV)).
+smt_interp0('nat2bv'(Size,Int),Res,Type) :- !,
+ integer(Size),
+ Size > 0,
+ (getval(real_for_int,1)@eclipse ->
+ IType = real_int
+ ; IType = int),
+ smt_interp(Int,IInt,IType),
+ Type = uint(Size),
+ (IType == real_int ->
+ Res = uintN_from_nat(Size,int_from_real(IInt))
+ ; Res = uintN_from_nat(Size,IInt)).
+smt_interp0('int2bv'(Size,Int),Res,Type) :- !,
+ integer(Size),
+ Size > 0,
+ (getval(real_for_int,1)@eclipse ->
+ IType = real_int
+ ; IType = int),
+ smt_interp(Int,IInt,IType),
+ Type = uint(Size),
+ (IType == real_int ->
+ Res = uintN_from_int(Size,int_from_real(IInt))
+ ; Res = uintN_from_int(Size,IInt)).
+% Les flottants
smt_interp0(fp(S,E,M),as(Val,Type),Type) :- !,
get_smt_float(S,E,M,Val,Type).
smt_interp0(to_fp(E,M,BV),Res,Type) :- !,
@@ -2228,7 +2491,7 @@ smt_interp0(to_fp(E,M,Rnd,F),Cast,Type) :- !,
(CastN == CastP ->
Cast = as(CastN,Type)
; % inexact
- unsupported_error("Cannot round Real with variable RoundingMode"))
+ true)
; ((TypeF == Type;
TypeF == float_simple,
Type == float_double)
@@ -2446,27 +2709,6 @@ smt_interp0('_'(BVNum,Size),as(Num,uint(Size)),uint(Size)) :- !,
get_int_from_bv('_'(BVNum,Size),Num,Size).
smt_interp0(bv(BX,S),as(Num,uint(Size)),uint(Size)) :- !,
get_int_from_bv(bv(BX,S),Num,Size).
-smt_interp0('bv2int'(BV),RES,int) :- !,
- smt_interp0('bv2nat'(BV),RES,int).
-smt_interp0('bv2nat'(BV),RES,int) :- !,
- smt_interp(BV,IBV,TBV),
- TBV=uint(SIZE),
- RES=int_from_uintN(SIZE,IBV).
-smt_interp0('int2bv'(Size,Int),Res,Type) :- !,
- smt_interp0('nat2bv'(Size,Int),Res,Type).
-smt_interp0('nat2bv'(Size,Int),Res,Type) :- !,
- integer(Size),
- Size > 0,
- smt_interp(Int,IInt,int),
- Type = uint(Size),
- ((nonvar(IInt),
- IInt = as(Val,_),
- integer(Val))
- ->
- to_intNu(Size,Val,ValN),
- Res = as(ValN,uint(Size))
- ; Res = uintN_from_int(Size,IInt)).
-
% cas particuliers
smt_interp0(concat(A,B),concat(SA,IA,SB,IB),uint(S)) :- !,
smt_interp(A,IA,uint(SA)),
@@ -2496,11 +2738,13 @@ smt_interp0(rotate_left(I,A),rotate_left(SA,NI,IA),uint(Size)) :- !,
smt_interp(I,NI,int),
integer(NI),
NI >= 0,
+ SA = Size,
smt_interp(A,IA,uint(Size)).
smt_interp0(rotate_right(I,A),rotate_right(SA,NI,IA),uint(Size)) :- !,
smt_interp(I,NI,int),
integer(NI),
NI >= 0,
+ SA = Size,
smt_interp(A,IA,uint(Size)).
smt_interp0(zero_extend(I,A),zero_extend(SA,NI,IA),uint(S)) :- !,
smt_interp(I,NI,int),
@@ -2549,11 +2793,10 @@ smt_interp0(bvsrem(A,B),bvsrem(S,IA,IB),uint(S)) :- !,
smt_interp0(bvsmod(A,B),bvsmod(S,IA,IB),uint(S)) :- !,
smt_interp(A,IA,uint(S)),
smt_interp(B,IB,uint(S)).
+smt_interp0(const(E),const_array(TI,TE,IE),array(TI,TE)) :- !,
+ smt_interp(E,IE,TE).
smt_interp0(store(A,I,E),store(IA,II,IE),array(TI,TE)) :- !,
smt_interp(A,IA,array(TI,TE)),
- (TE = array(_,_) ->
- unsupported_error("only scalar types for array element")
- ; true),
smt_interp(I,II0,TI),
check_eval(TI,II0,II),
smt_interp(E,IE0,TE),
@@ -2561,10 +2804,8 @@ smt_interp0(store(A,I,E),store(IA,II,IE),array(TI,TE)) :- !,
new_index_elem_val(TI,I),
new_index_elem_val(TE,E).
smt_interp0(select(A,I),select(IA,II),TE) :- !,
+ setval(keep_deltas_if_arrays,1)@eclipse,
smt_interp(A,IA,array(TI,TE)),
- (TE = array(_,_) ->
- unsupported_error("only scalar types for array element")
- ; true),
smt_interp(I,II0,TI),
check_eval(TI,II0,II),
new_index_elem_val(TI,I),
@@ -2575,7 +2816,7 @@ smt_interp0(T,IT,Type) :-
T =.. [F|ET],
((ET = [Args],
Args = [_|_],
- occurs(F,(and,or,xor,+,-,*,div,mod,/,=>,=,<,>,<=,>=,'fp.eq','fp.leq','fp.lt','fp.geq','fp.gt',bvand,bvor)))
+ occurs(F,(and,or,xor,+,-,*,div,mod,/,=>,=,<,>,<=,>=,'fp.eq','fp.leq','fp.lt','fp.geq','fp.gt',bvand,bvor,bvadd,bvmul)))
->
!,
(F == => ->
@@ -2608,6 +2849,7 @@ smt_interp0(T,IT,Type) :-
; length(ET,Ar),
getval(defined_funcs,Hfuncs),
hash_contains(Hfuncs,F/Ar),
+ (F/Ar == first/1 -> call(spy_here)@eclipse;true),
!,
(foreach(Arg,ET),
foreach((IArg,IType),IArgs) do
@@ -2625,8 +2867,8 @@ new_quantifier_abstraction(Res) :-
setval(quantifier,1),
% On cree une variable
get_decl_type_from_sort('Bool',NVar,Decl,bool),
- set_var_name(NVar,"ColQuant"),
- get_var_name(NVar,VS),
+ protected_set_var_name(NVar,"ColQuant"),
+ protected_get_var_name(NVar,VS),
atom_string(Id,VS),
add_binding(Id,bool,NVar),
(getval(decl,ODecl-End) ->
@@ -2637,6 +2879,12 @@ new_quantifier_abstraction(Res) :-
setval(decl,ODecl-NEnd),
Res = as(NVar,bool).
+% on garde les realString
+check_eval(Type,realString(Str),RE) ?- !,
+ RE = as(realString(Str),Type).
+% on traverse les as
+check_eval(_Type,as(E,Type),RE) ?- !,
+ check_eval(Type,E,RE).
check_eval(Type,E,RE) :-
(ground(E) ->
(var(Type) ->
@@ -2647,20 +2895,25 @@ check_eval(Type,E,RE) :-
; unfold_int_expr(E,0,_,Type,RE))
; RE = E).
-add_as(Type,as(I0,_),AsI) ?- !,
- remove_upper_as(I0,I,_),
- add_as(Type,I,AsI).
-add_as(array(_,_),I,AsI) ?- !,
- AsI = I.
add_as(Type,I,AsI) :-
+ remove_upper_as(I,NI,_),
+ add_as0(Type,NI,AsI).
+
+add_as0(array(TI,TE),I,AsI) ?- !,
+ AsI = as(I,array(TI,TE)).
+add_as0(Type,I,AsI) :-
nonvar(Type),
(var(I);
- atomic(I)),
+ atomic(I);
+ functor(I,F,_),
+ occurs(F,(uninterp,realString))),
+ !,
+ AsI = as(I,Type).
+add_as0(Type,I,AsI) :-
+ var(Type),
!,
AsI = as(I,Type).
-add_as(int,I,AsI) ?- !,
- AsI = as(I,int).
-add_as(_,I,I).
+add_as0(_,I,I).
check_rat_expr(Op,A,B,Rat) :-
check_rat_arg(A,RA),
@@ -2725,7 +2978,7 @@ get_decl_type_from_sort('Bool',NVar,Decl,bool) :- !,
Decl = int_vars(bool,NVar).
get_decl_type_from_sort('Int',NVar,Decl,Type) :- !,
get_type_from_sort('Int',Type,_),
- (Type == real ->
+ (Type == real_int ->
% simulation entiers non bornes
Decl = real_vars(real_int,NVar)
; Decl = int_vars(int,NVar)).
@@ -2749,8 +3002,23 @@ get_decl_type_from_sort('Float32',NVar,Decl,float_simple) :- !,
Decl = real_vars(float,NVar).
get_decl_type_from_sort('Float64',NVar,Decl,float_double) :- !,
Decl = real_vars(double,NVar).
+get_decl_type_from_sort(Term,NVar,Decl,Type) :-
+ compound(Term),
+ !,
+ functor(Term,F,Ar),
+ Term =.. [F|Sorts],
+ (known_sort(F,Ar,FSorts) ->
+ (foreach(Sort,Sorts),
+ foreach(NSort,NSorts) do
+ get_type_from_sort(Sort,NSort,_)),
+ NTerm =.. [F|NSorts],
+ Type = sort(NTerm),
+ Decl = sort_vars(Type,NVar)
+ ; term_string(Term,ST),
+ concat_string([" sort ",ST],Str),
+ unsupported_error(Str)).
get_decl_type_from_sort(Atom,NVar,Decl,Type) :- !,
- atom(Atom),
+ atomic(Atom),
% alias de type
(get_binding(Atom,Type,Type) ->
get_type_from_sort(_,Type,IType)
@@ -2760,8 +3028,8 @@ get_decl_type_from_sort(Atom,NVar,Decl,Type) :- !,
IType = Type
; concat_string([" sort ",Atom],Str),
unsupported_error(Str))),
- ((atom(Type),
- occurs(Type,(real,float_simple,float_double)))
+ ((atomic(Type),
+ occurs(Type,(real,real_int,float_simple,float_double)))
->
Decl = real_vars(IType,NVar)
; (Type = sort(_) ->
@@ -2770,10 +3038,23 @@ get_decl_type_from_sort(Atom,NVar,Decl,Type) :- !,
+get_type_from_sort(Var,ColType,Type) :-
+ var(Var),
+ !,
+ % poly déjà traité
+ ColType = Var,
+ Type = Var.
+get_type_from_sort(poly(Var),ColType,Type) :- !,
+ (var(Var) ->
+ ColType = Var,
+ Type = Var
+ ; get_type_from_sort(Var,ColType,Type)).
get_type_from_sort('Bool',bool,bool) :- !.
get_type_from_sort('Int',IType,Type) :-
+ setval(int_used,1)@eclipse,
(getval(real_for_int,1)@eclipse ->
- IType = real,
+% IType = real,
+ IType = real_int,
Type = real_int
; Type = IType,
IType = int),
@@ -2804,6 +3085,8 @@ get_type_from_sort('Array'(SI,SE),array(TI,TE),array(TI,TE)) :- !,
get_type_from_sort(SI,TI,_),
get_type_from_sort(SE,TE,_).
get_type_from_sort(Atom,Type,Type) :-
+ atom(Atom),
+ !,
% alias de type ?
(get_binding(Atom,Type,Type) ->
true
@@ -2811,8 +3094,23 @@ get_type_from_sort(Atom,Type,Type) :-
Type = sort(Atom)
; term_string(Atom,S),
concat_string(["Undefined/undeclared sort ",S],Mess),
- writeln(output,Mess),
+ writeln(error,Mess),
exit_block(syntax))).
+get_type_from_sort(Term,CType,Type) :-
+ compound(Term),
+ !,
+ functor(Term,F,Ar),
+ Term =.. [F|Sorts],
+ (known_sort(F,Ar,FSorts) ->
+ (foreach(Sort,Sorts),
+ foreach(NSort,NSorts) do
+ get_type_from_sort(Sort,NSort,_)),
+ NTerm =.. [F|NSorts],
+ CType = Type,
+ Type = sort(NTerm)
+ ; term_string(Term,ST),
+ concat_string([" sort ",ST],Str),
+ unsupported_error(Str)).
get_sort_from_type(sort(SId),Sort) ?- !,
@@ -2841,9 +3139,9 @@ check_rnd(Rnd) :-
IRnd = as(VRnd,_),
var(VRnd))
->
- write(error,"Warning RoundingMode variable "),
+ write(error,"(error \"Warning RoundingMode variable "),
write(error,Rnd),
- writeln(error," is interpreted as RNE.")
+ writeln(error," is interpreted as RNE\")")
; true),
check_rnd0(IRnd).
@@ -3017,7 +3315,8 @@ get_int_from_bv('_'(BVNum,Size),Num,Size) :- !,
Size > 0)
->
true
- ; unknown_syntax_error).
+ ; writeln(error,"(error \"Unknown syntax error\")"),
+ exit_block(syntax)).
get_int_from_bv(bv(BX,BVS),I,Size) :-
string_length(BVS,Len),
(BX == "x" ->
@@ -3029,12 +3328,12 @@ get_int_from_bv(bv(BX,BVS),I,Size) :-
smt_interp_file(File,NewGoals) :-
garbage_collect,
+ init_binding,
%statistics(session_time,T0),
parse_smtlib_file(File,LG),
%statistics(session_time,T1),
%Diff is T1-T0,
%writeln(output,smt_parse:Diff),
- init_binding,
% on pourrait faire une premiere passe
% pour voire les ids atteignables
% depuis les assert et ne parser ensuite
@@ -3048,7 +3347,10 @@ smt_interp_file(File,NewGoals) :-
fromto(true,IG,OG,Goals) do
ITail = [_|OTail],
check_inline_goal(G,OTail),
- smt_interp0(G,Goal,bool),
+ block(smt_interp0(G,Goal,bool),
+ Tag,
+ (call(spy_here)@eclipse,
+ smt_interp0(G,Goal,bool))),
functor(Goal,FG,_),
(FG == array_def ->
OS = IS,
@@ -3087,6 +3389,18 @@ smt_interp_file(File,NewGoals) :-
setval(in_let,0),
setval(seen_expr,0).
+remove_true_decl((Beg,End),Decl) ?- !,
+ remove_true_decl(End,Decl0),
+ ((Decl0 == true ;
+ Decl0 = int_vars(bool,B),
+ nonvar(B);
+ Decl0 = as(1,bool))
+ ->
+ remove_true_decl(Beg,Decl)
+ ; remove_true_decl(End,Decl1),
+ make_conj(Decl0,Decl1,Decl)).
+remove_true_decl(D,D).
+
check_inline_goal('define-fun'(F,[],_,_),Goals) ?- !,
(at_least_two_use(F,Goals) ->
setval(inline_def,0)
@@ -3094,12 +3408,6 @@ check_inline_goal('define-fun'(F,[],_,_),Goals) ?- !,
check_inline_goal(_,_) :-
setval(inline_def,0).
-/*
- statistics(session_time,NT),
- NDiff is NT-T0,
- writeln(output,smt_interp:NDiff).
-*/
-
at_least_two_use(F,Goals) :-
setval(cpt_use,0),
@@ -3157,6 +3465,39 @@ cgiveInstancePath(N,ArEnd,ST,T,Forbiden,LC) :-
N1 is N+1,
cgiveInstancePath(N1,ArEnd,ST,T,Forbiden,LC).
+% cherche un chemin P et une instance de ST dans T
+cgiveInstanceAndPath(ST,T,Inst,P) :-
+ cgiveInstanceAndPath(ST,T,[],Inst,P).
+% whith a list of function forbiden under which ST is
+% not searched.
+cgiveInstanceAndPath(ST,T,_,T,[]) :-
+ instance(T,ST).
+cgiveInstanceAndPath(ST,T,Forbiden,Inst,P) :-
+ compound(T),
+ functor(T,Name,Arite),
+ (\+ occurs(Name,Forbiden)),
+ Arite1 is Arite + 1,
+ cgiveInstanceAndPath(1,Arite1,ST,T,Forbiden,Inst,P).
+
+%subfunction of giveInstancePath/4 with index of path actualy reached
+% and the limit. The searched is in large (parcours en largeur).
+cgiveInstanceAndPath(ArEnd,ArEnd,_,_,_,_,_) :- !,fail.
+cgiveInstanceAndPath(N,_ArEnd,ST,T,Forbiden,Inst,[N|LI]) :-
+ arg(N,T,S),
+ ( (instance(S,ST),
+ Inst = S,
+ LI = [])
+ ; (compound(S),
+ functor(S,Name,N_A),
+ (\+ occurs(Name,Forbiden)),
+ NArEnd is N_A + 1,
+ cgiveInstanceAndPath(1,NArEnd,ST,S,Forbiden,Inst,LI))).
+cgiveInstanceAndPath(N,ArEnd,ST,T,Forbiden,Inst,LC) :-
+ N1 is N+1,
+ cgiveInstanceAndPath(N1,ArEnd,ST,T,Forbiden,Inst,LC).
+
+
+
%% replace_at_path_in_term(Path,T,ST) :
%% remplace, en place dans T, le sous terme au bout du chemin Path par ST
creplace_at_path_in_term([I|Path],T,ST) :-
@@ -3165,6 +3506,7 @@ creplace_at_path_in_term([I|Path],T,ST) :-
; arg(I,T,TI),
creplace_at_path_in_term(Path,TI,ST)).
%% Idem mais copie
+creplace_at_path_in_term([],T,ST,ST).
creplace_at_path_in_term([I|Path],T,ST,NT) :-
arg(I,T,TI),
T =.. [FT|Args],
@@ -3213,3 +3555,4 @@ only_one_occ(Var,Term) :-
fail
; fail).
only_one_occ(_,_).
+
diff --git a/Src/COLIBRI/smt_import.pl b/Src/COLIBRI/smt_import.pl
index e6e8caab41c89f4bc52bb7a80c0a728523f97e5f..4dc76a9a0ab3a3f7f591e7b30d5a92e840a1841c 100644
--- a/Src/COLIBRI/smt_import.pl
+++ b/Src/COLIBRI/smt_import.pl
@@ -963,20 +963,20 @@ dump_type_val('Real',Val0,Val) ?- !,
; mreal:dvar_range(Val0,L,H),
rational(L,RL),
rational(H,RH),
- numerator(RL,NumL),
- denominator(RL,DenL),
+ protected_numerator(RL,NumL),
+ protected_denominator(RL,DenL),
(DenL == 1 ->
concat_string([NumL,".0"],SL)
; concat_string(["(/ ",NumL,".0 ",DenL,".0)"],SL)),
- numerator(RH,NumH),
- denominator(RH,DenH),
+ protected_numerator(RH,NumH),
+ protected_denominator(RH,DenH),
(DenH == 1 ->
concat_string([NumH,".0"],SH)
; concat_string(["(/ ",NumH,".0 ",DenH,".0)"],SH)),
concat_string(["(range ",SL," ",SH,")"], Val))
; rational(Val0,Val1),
- numerator(Val1,Num),
- denominator(Val1,Den),
+ protected_numerator(Val1,Num),
+ protected_denominator(Val1,Den),
(Den == 1 ->
concat_string([Num,".0"],Val)
; concat_string(["(/ ",Num,".0 ",Den,".0)"],Val))).
@@ -1338,7 +1338,24 @@ init_binding :-
define_smt_func(F,TypedArgs,Type,Expr) :-
length(TypedArgs,Ar),
getval(defined_funcs,Hfuncs),
- hash_set(Hfuncs,F/Ar,(TypedArgs,Type,Expr)).
+ % on extraie les LetVars pour pouvoir les filtrer
+ % et éviter des les unifier dans appels multiples
+ TExpr = f(Expr),
+ findall(LetP,
+ cgiveInstancePath(let(_,_),TExpr,LetP),
+ LetPaths),
+ (foreach(LetPath,LetPaths),
+ fromto([],IL,OL,LetVars),
+ param(TExpr) do
+ arg(LetPath,TExpr,let(LetTriples,_)),
+ (foreach((LetVar,_,_),LetTriples),
+ fromto(IL,IIL,OOL,OL) do
+ ((nonvar(LetVar);
+ occurs(LetVar,IIL))
+ ->
+ OOL = IIL
+ ; OOL = [LetVar|IIL]))),
+ hash_set(Hfuncs,F/Ar,(TypedArgs,Type,LetVars,Expr)).
define_smt_uifunc(F,Ar,RI) :-
length(Types,Ar),
@@ -1353,42 +1370,54 @@ defined_smt_func(F/Ar,IArgs,Type,IExpr) :-
; concat_string(["(error \"Undefined function:",F,/,Ar,"\")"],Err),
writeln(error,Err),
exit_block(syntax)),
- (Profile = (FArgs,FType,FIExpr) ->
+ (Profile = (FArgs,FType,LetVars,FIExpr) ->
% on lie les parametres actuels/formels
+ copy_term((FArgs,FIExpr),(CFArgs,CFIExpr)),
+ term_variables((FArgs,FIExpr),FVars),
+ term_variables((CFArgs,CFIExpr),CFVars),
+ % on ignore les LetVars dans VarsAss
+ % pour ne pas les unifier d'un appel à l'autre
+ (foreach(FV,FVars),
+ foreach(CFV,CFVars),
+ fromto(VarsAss,OVA,IVA,[]),
+ param(LetVars) do
+ (occurs(FV,LetVars) ->
+ OVA = IVA
+ ; OVA = [[FV|CFV]|IVA])),
(foreach((IArg,IArgType),IArgs),
- foreach((FIArg,FIArgType),FArgs),
- fromto(FIExpr,IE,OE,IExpr0) do
- % On doit remplacer toutes les occurences de FIArg par IArg
- % sans faire une unification (pour les autres appels)
- % Comme defined_funcs est une ref, on garde bien les
- % variables globalles de FIExpr
- findall(ATP,
- cgiveVarInstancePath(FIArgType,IE,[],ATP),
- ATPaths),
- (foreach(ATP,ATPaths),
- fromto(IE,IE0,OE0,OE1),
- param(IArgType) do
- creplace_at_path_in_term(ATP,IE0,IArgType,OE0)),
- findall(P,
- cgiveVarInstancePath(FIArg,OE1,[],P),
- Paths),
- (foreach(P,Paths),
- fromto(OE1,IIE,OOE,OE),
- param(IArg) do
- creplace_at_path_in_term(P,IIE,IArg,OOE)),
+ foreach((FIArg,FIArgType),CFArgs),
+ fromto(CFIExpr,IE,OE,IExpr0),
+ fromto(VarsAss,IVA,OVA,NVarsAss) do
+ (FIArgType == IArgType ->
+ OE1 = IE
+ ; findall(ATP,
+ cgiveVarInstancePath(FIArgType,IE,[],ATP),
+ ATPaths),
+ (foreach(ATP,ATPaths),
+ fromto(IE,IE0,OE0,OE1),
+ param(IArgType) do
+ creplace_at_path_in_term(ATP,IE0,IArgType,OE0))),
+ once (member_begin_end([_|FIArg0],IVA,OVA,EndOVA,EndOVA),
+ FIArg0 == FIArg),
+ protected_unify(FIArg,IArg),
+ OE = OE1,
((nonvar(IArgType),
IArgType = sort(Sort))
->
% Peuplement des valeurs de Sort
new_sort_val(Sort)
; true)),
- findall(PT,
- cgiveVarInstancePath(FType,IExpr0,[],PT),
- TPaths),
- (foreach(PT,TPaths),
- fromto(IExpr0,NIIE,NOOE,IExpr),
- param(Type) do
- creplace_at_path_in_term(PT,NIIE,Type,NOOE))
+ (FType == Type ->
+ IExpr = IExpr0
+ ; findall(PT,
+ cgiveVarInstancePath(FType,IExpr0,[],PT),
+ TPaths),
+ (foreach(PT,TPaths),
+ fromto(IExpr0,NIIE,NOOE,IExpr),
+ param(Type) do
+ creplace_at_path_in_term(PT,NIIE,Type,NOOE))),
+ (foreach([GV|CGV],NVarsAss) do
+ protected_unify(GV,CGV))
; % Symbole non-interprete
(foreach((IArg,IArgType),IArgs),
foreach(NIArg,NIArgs) do
@@ -1406,7 +1435,6 @@ defined_smt_func(F/Ar,IArgs,Type,IExpr) :-
Term =.. [F|NIArgs],
(Profile == real_int ->
% simulation des entiers non bornes
-% IExpr = as(setIntegral(uninterp(Term)),Type)
IExpr = as(setIntegral(as(uninterp(Term),real_int)),real_int)
; IExpr = as(uninterp(Term),Type))),
((nonvar(Type),
@@ -1697,7 +1725,7 @@ smt_interp0(set_default_int_bounds(L,H),set_default_int_bounds(Low,High),bool)
setval(real_for_int,0)@eclipse
; unsupported_error("set_default_int_bounds needs min/max integer values")).
-smt_interp0(assert(A0),NDecl,bool) :- !,
+smt_interp0(assert(A0),NewDecl,bool) :- !,
getval(decl,OD),
setval(decl,End-End),
reset_let_vars,
@@ -1754,6 +1782,7 @@ smt_interp0(assert(A0),NDecl,bool) :- !,
; NDecl = as(0,bool))
; NDecl = Decl))),
reset_let_vars,
+ remove_true_decl(NDecl,NewDecl),
setval(decl,OD).
smt_interp0(array_def(Var,Def),array_def(IVar,IDef),bool) :- !,
smt_interp(Var,IVar,Type),
@@ -3341,7 +3370,10 @@ smt_interp_file(File,NewGoals) :-
fromto(true,IG,OG,Goals) do
ITail = [_|OTail],
check_inline_goal(G,OTail),
- smt_interp0(G,Goal,bool),
+ block(smt_interp0(G,Goal,bool),
+ Tag,
+ (call(spy_here)@eclipse,
+ smt_interp0(G,Goal,bool))),
functor(Goal,FG,_),
(FG == array_def ->
OS = IS,
@@ -3380,7 +3412,17 @@ smt_interp_file(File,NewGoals) :-
setval(in_let,0),
setval(seen_expr,0).
-
+remove_true_decl((Beg,End),Decl) ?- !,
+ remove_true_decl(End,Decl0),
+ ((Decl0 == true ;
+ Decl0 = int_vars(bool,B),
+ nonvar(B);
+ Decl0 = as(1,bool))
+ ->
+ remove_true_decl(Beg,Decl)
+ ; remove_true_decl(End,Decl1),
+ make_conj(Decl0,Decl1,Decl)).
+remove_true_decl(D,D).
check_inline_goal('define-fun'(F,[],_,_),Goals) ?- !,
(at_least_two_use(F,Goals) ->
@@ -3501,29 +3543,29 @@ creplace_at_path_in_term([I|Path],T,ST,NT) :-
; creplace_at_path_in_term(Path,TI,ST,NTI)).
cgiveVarInstancePath(V,V,_,P) ?- !,
- P = [].
+ P = [].
cgiveVarInstancePath(V,T,Forbiden,P) :-
- compound(T),
- functor(T,Name,Arite),
- (\+ (number(Name) ->
+ compound(T),
+ functor(T,Name,Arite),
+ (\+ (number(Name) ->
member(Name,Forbiden)
; occurs(Name,Forbiden))),
- Arite1 is Arite + 1,
- cgiveVarInstancePath(1,Arite1,V,T,Forbiden,P).
+ Arite1 is Arite + 1,
+ cgiveVarInstancePath(1,Arite1,V,T,Forbiden,P).
cgiveVarInstancePath(ArEnd,ArEnd,_,_,_,_) :- !,fail.
cgiveVarInstancePath(N,_ArEnd,Var,T,Forbiden,[N|LI]) :-
- arg(N,T,S),
- ( (S == Var,
- LI = [])
- ; (compound(S),
- functor(S,Name,N_A),
- (\+ occurs(Name,Forbiden)),
- NArEnd is N_A + 1,
- cgiveVarInstancePath(1,NArEnd,Var,S,Forbiden,LI))).
+ arg(N,T,S),
+ ( (S == Var,
+ LI = [])
+ ; (compound(S),
+ functor(S,Name,N_A),
+ (\+ occurs(Name,Forbiden)),
+ NArEnd is N_A + 1,
+ cgiveVarInstancePath(1,NArEnd,Var,S,Forbiden,LI))).
cgiveVarInstancePath(N,ArEnd,Var,T,Forbiden,LC) :-
- N1 is N+1,
- cgiveVarInstancePath(N1,ArEnd,Var,T,Forbiden,LC).
+ N1 is N+1,
+ cgiveVarInstancePath(N1,ArEnd,Var,T,Forbiden,LC).
only_one_occ(Var,Term) :-
diff --git a/Src/COLIBRI/solve.pl b/Src/COLIBRI/solve.pl
index 71f957f1a0d5a02895f31ab8a46564f02628aaf4..4fd129a2833e02424cc3e012f702bb93fa866383 100644
--- a/Src/COLIBRI/solve.pl
+++ b/Src/COLIBRI/solve.pl
@@ -84,8 +84,8 @@ trans_col(power_int(X,_,P,Z,_),X^P #= Z).
trans_col(abs_val_int(X,Y),abs(X) #= Y).
trans_col(op_int(X,Y),-X #= Y).
trans_col(absA_lt_absB(X,Y),abs(X) #< abs(Y)).
-trans_col(min_int(X,Y,Z),min(X,X) #= Z).
-trans_col(max_int(X,Y,Z),max(X,X) #= Z).
+trans_col(min_int(X,Y,Z),min(X,Y) #= Z).
+trans_col(max_int(X,Y,Z),max(X,Y) #= Z).
trans_col(geq(X,Y),X #>= Y).
trans_col(gt(X,Y),X #> Y).
trans_col(diff_int(X,Y),X #\= Y).
@@ -104,13 +104,13 @@ trans_col(float_to_real_bis(Type,X,Y),T $= Y) :-
trans_col(cast_int_real1(Type,X,Y),T $= Y) :-
(Type == float_simple ->
T = float_from_int(X)
- ; (T == float_double ->
+ ; (Type == float_double ->
T = double_from_int(X)
; T = real_from_int(X))).
trans_col(cast_real_int1(Type,X,Y),T $= Y) :-
(Type == float_simple ->
T = int_from_float(X)
- ; (T == float_double ->
+ ; (Type == float_double ->
T = int_from_double(X)
; T = int_from_real(X))).
trans_col(cast_float_to_double_bis(X,Y),double_from_float(X) $= Y).
@@ -132,7 +132,7 @@ trans_col(gt_real(_,X,Y),X $> Y).
trans_col(logn1(_,X,Y),ln(X) $= Y).
trans_col(exp1(_,X,Y),exp(X) $= Y).
-trans_col(eq_int_reif(T,X,Y,Z),(X #= Y) #= Z).
+trans_col(eq_int_reif(_T,X,Y,Z),(X #= Y) #= Z).
trans_col(geq_int_reif(X,Y,Z),(X #>= Y) #= Z).
trans_col(gt_int_reif(X,Y,Z),(X #> Y) #= Z).
trans_col(eq_real_reif(_,X,Y,Z),(X $= Y) #= Z).
@@ -157,7 +157,6 @@ trans_col(or_seq_reif(X,_,Y,Z),(X or Y) #= Z).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% TODO : ajouter declaration type pour BV
unfold_int_expr_block(E,D,C,T,R) :-
- NC = true,
get_priority(P),
call_priority(
block(once unfold_int_expr(E,D,C,T,R),
@@ -213,24 +212,20 @@ unfold_int_expr_block(E,D,C,T,R) :-
call(C).
% version specifique pour les definitions de tableaux
array_def(Var,Def) :-
- (getval(check_sat_vars,1)@eclipse ->
- true
- ; (((var(Var),V = Var;
- Var = as(V,Type),var(V)),
- not occurs(V,Def))
- ->
- get_variable_type(V,Type),
- unfold_int_expr_block(Def,0,C,Type,V),
- call(C)
- ; '#='(Var,Def))).
+ (((var(Var),V = Var;
+ Var = as(V,Type),var(V)),
+ not occurs(V,Def))
+ ->
+ get_variable_type(V,Type),
+ unfold_int_expr_block(Def,0,C,Type,V),
+ call(C)
+ ; '#='(Var,Def)).
array_elt_def(E,A,I) :-
- (getval(check_sat_vars,1)@eclipse ->
- true
- ; unfold_int_expr(A,0,_true,array(TI,TE),IA),
- (real_type(TE,_) ->
- select(IA,I) $= E
- ; select(IA,I) #= E)).
-
+ unfold_int_expr(A,0,_true,array(_TI,TE),IA),
+ (real_type(TE,_) ->
+ select(IA,I) $= E
+ ; select(IA,I) #= E).
+
'#<'(L,R) :-
unfold_int_expr_block(L #< R,0,C,bool,1),
call(C).
@@ -368,7 +363,7 @@ array_vars(TypeI,TypeE0,X) :-
true
; add_typed_var(X,array(TypeI,TypeE)),
insert_dep_inst(inst_cstr(0,X))).
-array_vars(TypeI,TypeE,X).
+array_vars(_,_,_).
int_vars(sort(S),T) ?- !,
sort_vars(sort(S),T).
@@ -396,7 +391,8 @@ let_int_vars(int,T) ?- !,
; % on retarde le typage par defaut des int
% definis dans les let
add_typed_var(X,int),
- %set_int_type(Type,X),
+ % pourquoi ??
+ set_int_type(int,X),
insert_dep_inst(inst_cstr(0,X)))).
let_int_vars(Type,T) :-
int_vars(Type,T).
@@ -413,7 +409,7 @@ set_int_type(uint(N),X) ?-
% unsigned N bits
integer(N),
N >= 1,!,
- intN_min_max(u,N,L,H),
+ intN_min_max(u,N,_L,H),
mfd:set_intervals(X,[0..H]).
set_int_type(int,X) ?- !,
% default integer bounds
@@ -448,8 +444,9 @@ add_typed_var(V,Type) :-
(hash_get(Hash,VA,(_,Type0)) ->
(Type == Type0 ->
true
- ; call(spy_here)@eclipse,write(error,"Type error for variable "),
- writeln(error,X:Type0),
+ ; call(spy_here)@eclipse,
+ write(error,"Type error for variable "),
+ writeln(error,V:Type0),
exit_block(syntax))
; hash_set(Hash,VA,(V,Type)),
setval(typed_vars,Hash))).
@@ -494,7 +491,6 @@ check_int_var_type(V,Type) :-
Hash \== 0,
get_variable_atom(V,VA),
hash_get(Hash,VA,(_,Type0)),
-% (Type = Type0 ->
(compatible_types(Type,Type0) ->
true
; call(spy_here)@eclipse,write(error,"Type error for variable "),
@@ -505,17 +501,6 @@ check_int_var_type(V,Type) :-
% car les cast de int vers/depuis int(_)/uint(_) et les bveq
% peuvent provoquer des unifications entre ces types
% quand il n'y a pas de debordement !!
-/*
-compatible_types(T1,T2) :-
- (T1 = T2 ->
- true
- ; (ITypes = [int,int(_),uint(_)];
- % patch pour bug introuvable sur totest/add_01_1_2.smt2
- % (trop gros)
- ITypes = [bool,uint(1)]),
- member(T1,ITypes),
- member(T2,ITypes)).
-*/
compatible_types(T1,T2) :-
(T1 = T2 ->
true
@@ -533,7 +518,6 @@ get_int_var_type(V,Type) :-
exit_block(syntax)
; get_variable_atom(V,VA),
(hash_get(Hash,VA,(_,Type0)) ->
-% (Type = Type0 ->
(compatible_types(Type,Type0) ->
true
; call(spy_here)@eclipse,write(error,"Type error for variable "),
@@ -563,7 +547,7 @@ to_int(int,V,R) :-
use_overflow :-
setval(no_overflow,0)@eclipse.
no_overflow :-
- setval(no_overflow,A)@eclipse.
+ setval(no_overflow,1)@eclipse.
check_overflow(UO) :-
(getval(no_overflow,1)@eclipse ->
protected_unify(UO,0)
@@ -652,7 +636,7 @@ abs_val(int(N),D,A,R,UO) :-
%insert_dep_inst(inst_cstr(D,UO)),
insert_dep_inst(dep(A,D,[UO])),
insert_dep_inst(dep(R,D,[UO])).
-abs_val(uint(N),_,A,A,0).
+abs_val(uint(_N),_,A,A,0).
power(Type,D,A,P,B,UO) :-
check_overflow(UO),
@@ -771,7 +755,7 @@ logA(A,0,P) ?- !,
% fail !
A = 0,
mfd:dvar_remove_smaller(P,1).
-logA(A,1,P) ?- !,
+logA(_A,1,P) ?- !,
% A <> 0 et 1 donc P = 0
P = 0.
logA(A,B,P) :-
@@ -859,7 +843,7 @@ blocked_call(Goal) :-
; exit_block(unsat)).
-unfold_int_expr(X,D,Cstr,Type,R) :-
+unfold_int_expr(X,_D,Cstr,Type,R) :-
var(X),
!,
((get_variable_type(X,Type);
@@ -885,8 +869,7 @@ unfold_int_expr(as(EA,Type0),D,Cstr,Type,R) ?- !,
Type = Type0,
unfold_int_expr(EA,D,Cstr,Type,R).
%% Essai array
-unfold_int_expr(store(EA,EI,EE), D, Cstr, Type, R) ?-
- ND is D + 1,
+unfold_int_expr(store(EA,EI,EE), _D, Cstr, Type, R) ?-
unfold_int_expr(EA,0,CA,Type,A),
Type = array(TI,TE),
(real_type(TI,_) ->
@@ -914,18 +897,9 @@ unfold_int_expr(store(EA,EI,EE), D, Cstr, Type, R) ?-
insert_dep_inst(dep(E,0,[I,Start]))
; true),
- ((nonvar(EE),
- EE = select(_,_))
- ->
- blocked_unify(R,storec(A,I,v(u,E,true))),
- make_conj(CA,CI,CAI),
- make_conj(CAI,CE,Cstr)
- ; (nonvar(E) ->
- % donc CE true, pendant check_sat_vars ?
- blocked_unify(R,storec(A,I,v(u,E,true)))
- ; blocked_unify(R,storec(A,I,v(u,E,CE)))),
- make_conj(CA,CI,Cstr)).
-unfold_int_expr(storec(A,I,E), D, Cstr, Type, R) ?-
+ blocked_unify(R,storec(A,I,v(u,E,CE))),
+ make_conj(CA,CI,Cstr).
+unfold_int_expr(storec(A,I,E), _D, Cstr, Type, R) ?-
% constructeur interne
!,
get_array_type(A,Type),
@@ -993,11 +967,9 @@ unfold_int_expr(bvand(Size,EA,EB), D, Cstr, Type, R) ?-
bvand(Size,A,B,R0),
blocked_unify(R,R0),
Cstr = CAB
- ; (fail,Size == 1 ->
- int_vars(Type,[A,B,R])
- ; set_int_type(Type,A),
- set_int_type(Type,B),
- set_int_type(Type,R)),
+ ; set_int_type(Type,A),
+ set_int_type(Type,B),
+ set_int_type(Type,R),
insert_dep_inst(dep(R,D,[A,B])),
insert_dep_inst(dep(A,D,[R,B])),
insert_dep_inst(dep(B,D,[R,A])),
@@ -1019,11 +991,9 @@ unfold_int_expr(bvor(Size,EA,EB), D, Cstr, Type, R) ?-
bvor(Size,A,B,R0),
blocked_unify(R,R0),
Cstr = CAB
- ; (fail,Size == 1 ->
- int_vars(Type,[A,B,R])
- ; set_int_type(Type,A),
- set_int_type(Type,B),
- set_int_type(Type,R)),
+ ; set_int_type(Type,A),
+ set_int_type(Type,B),
+ set_int_type(Type,R),
insert_dep_inst(dep(R,D,[A,B])),
insert_dep_inst(dep(A,D,[R,B])),
insert_dep_inst(dep(B,D,[R,A])),
@@ -1047,11 +1017,9 @@ unfold_int_expr(xorb(Size,EA,EB), D, Cstr, Type, R) ?-
bvxor(Size,A,B,R0),
blocked_unify(R,R0),
Cstr = CAB
- ; (fail,Size == 1 ->
- int_vars(Type,[A,B,R])
- ; set_int_type(Type,A),
- set_int_type(Type,B),
- set_int_type(Type,R)),
+ ; set_int_type(Type,A),
+ set_int_type(Type,B),
+ set_int_type(Type,R),
insert_dep_inst(dep(R,D,[A,B])),
insert_dep_inst(dep(A,D,[R,B])),
insert_dep_inst(dep(B,D,[R,A])),
@@ -1212,7 +1180,6 @@ X #\= Y,
solve_cstrs.
*/
unfold_int_expr(bvsdiv(Size,EA,EB), D, Cstr, Type, R) ?-
- ND is D + 1,
integer(Size),
Size > 0,
!,
@@ -1264,7 +1231,6 @@ X #\= Y,
solve_cstrs.
*/
unfold_int_expr(bvsrem(Size,EA,EB), D, Cstr, Type, R) ?-
- ND is D + 1,
integer(Size),
Size > 0,
!,
@@ -1323,7 +1289,6 @@ X #\= Y,
solve_cstrs.
*/
unfold_int_expr(bvsmod(Size,EA,EB), D, Cstr, Type, R) ?-
- ND is D + 1,
integer(Size),
Size > 0,
!,
@@ -1785,7 +1750,7 @@ unfold_int_expr(intN_from_uint(N,EA),D,Cstr,Type,R) ?-
uintN_to_intN(N,A,R0,UO),
blocked_unify(R,R0),
Cstr = CA
- ; get_reif_var_depth_from_labchoice(DD),
+ ; %get_reif_var_depth_from_labchoice(DD),
%insert_dep_inst(inst_cstr(DD,UO)),
insert_dep_inst(dep(A,D,[UO])),
insert_dep_inst(dep(R,D,[A,UO])),
@@ -1799,7 +1764,7 @@ unfold_int_expr(uintN_from_int(N,EA),D,Cstr,Type,R) ?-
!,
Type = uint(N),
(number(A) ->
- to_intNu(N,A,R),
+ to_intNu(N,A,R0),
blocked_unify(R,R0),
Cstr = CA
; insert_dep_inst(dep(R,D,[A])),
@@ -1825,12 +1790,12 @@ unfold_int_expr(uintN_from_intN(N,EA),D,Cstr,Type,R) ?-
set_int_type(int(N),A),
!,
Type = uint(N),
- get_reif_var_depth_from_labchoice(DD),
(number(A) ->
intN_to_uintN(N,A,R0,UO),
blocked_unify(R,R0),
Cstr = CA
- ; %insert_dep_inst(inst_cstr(DD,UO)),
+ ; %get_reif_var_depth_from_labchoice(DD),
+ %insert_dep_inst(inst_cstr(DD,UO)),
insert_dep_inst(dep(A,D,[UO])),
insert_dep_inst(dep(R,D,[A,UO])),
make_conj(CA,intN_to_uintN(N,A,R,UO),Cstr)).
@@ -2047,7 +2012,7 @@ unfold_int_expr(EA mod EB,D,Cstr,Type,R) ?-
unfold_int_expr(EA ^ EN,D,Cstr,Type,R) ?-
ND is D + 1,
unfold_int_expr(EA,ND,CA,Type,A),
- unfold_int_expr(EN,ND,CN,Type1,N),
+ unfold_int_expr(EN,ND,CN,_Type1,N),
!,
insert_dep_inst(dep(R,D,[A,N])),
make_conj(CA,CN,CAN),
@@ -2121,6 +2086,7 @@ unfold_int_expr(EA #= EB,D,Cstr,Type0,R) ?-
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
make_conj(CA,CB,CAB),
+/*
((nonvar(Type),
Type \== int,
Type \== bool)
@@ -2129,9 +2095,10 @@ unfold_int_expr(EA #= EB,D,Cstr,Type0,R) ?-
US = u
; Type = int(Size),
US = s),
- intN_min_max(US,Size,Min,Max)
+ intN_min_max(US,Size,Min,_Max)
; true),
- ((nonvar(Min),
+ ((Type == int,
+ nonvar(Min),
(number(A),C = A;
number(EA),to_int(Type,EA,C)),
var(B))
@@ -2139,7 +2106,8 @@ unfold_int_expr(EA #= EB,D,Cstr,Type0,R) ?-
% CA = B
Inter = [C],
Goal = in_intervals_reif(Type,B,Inter,R)
- ; ((nonvar(Min),
+ ; ((Type == int,
+ nonvar(Min),
(number(B),C = B;
number(EB),to_int(Type,EB,C)),
var(A))
@@ -2148,6 +2116,8 @@ unfold_int_expr(EA #= EB,D,Cstr,Type0,R) ?-
Inter = [C],
Goal = in_intervals_reif(Type,A,Inter,R)
; Goal = eq_int_reif(Type,B,A,R))),
+*/
+ Goal = eq_int_reif(Type,B,A,R),
make_conj(CAB,Goal,Cstr)
; (R == 1 ->
make_conj(CA,CB,Cstr)
@@ -2189,7 +2159,8 @@ unfold_int_expr(EA #\= EB,D,Cstr,Type0,R) ?-
make_conj(CA,CB,CAB),
(Type == bool ->
make_conj(CAB,diff_int_reif(A,B,R),Cstr)
- ; ((nonvar(Type),
+ ; /*
+ ((nonvar(Type),
Type \== int)
->
(Type = uint(Size) ->
@@ -2198,7 +2169,8 @@ unfold_int_expr(EA #\= EB,D,Cstr,Type0,R) ?-
US = s),
intN_min_max(US,Size,Min,Max)
; true),
- ((nonvar(Min),
+ ((Type == int,
+ nonvar(Min),
(number(A),C = A;
number(EA),to_int(Type,EA,C)),
var(B))
@@ -2212,7 +2184,8 @@ unfold_int_expr(EA #\= EB,D,Cstr,Type0,R) ?-
Inter = [NA..Max]
; Inter = [Min..PA,NA..Max]),
Goal = in_intervals_reif(Type,B,Inter,R)
- ; ((nonvar(Min),
+ ; ((Type == int,
+ nonvar(Min),
(number(B),C = B;
number(EB),to_int(Type,EB,C)),
var(A))
@@ -2227,6 +2200,8 @@ unfold_int_expr(EA #\= EB,D,Cstr,Type0,R) ?-
; Inter = [Min..PB,NB..Max]),
Goal = in_intervals_reif(Type,A,Inter,R)
; Goal = diff_int_reif(B,A,R))),
+ */
+ Goal = diff_int_reif(B,A,R),
make_conj(CAB,Goal,Cstr))
; (R == 0 ->
make_conj(CA,CB,Cstr)
@@ -2301,6 +2276,7 @@ unfold_int_expr(EA #< EB,D,Cstr,Type0,R) ?-
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
make_conj(CA,CB,CAB),
+/*
((nonvar(Type),
Type \== int)
->
@@ -2310,7 +2286,8 @@ unfold_int_expr(EA #< EB,D,Cstr,Type0,R) ?-
US = s),
intN_min_max(US,Size,Min,Max)
; true),
- ((nonvar(Min),
+ ((%Type == int,
+ nonvar(Min),
(number(A),C = A;
number(EA),to_int(Type,EA,C)),
var(B))
@@ -2319,7 +2296,8 @@ unfold_int_expr(EA #< EB,D,Cstr,Type0,R) ?-
NA is C + 1,
Inter = [NA..Max],
Goal = in_intervals_reif(Type,B,Inter,R)
- ; ((nonvar(Min),
+ ; ((%Type == int,
+ nonvar(Min),
(number(B),C = B;
number(EB),to_int(Type,EB,C)),
var(A))
@@ -2329,6 +2307,8 @@ unfold_int_expr(EA #< EB,D,Cstr,Type0,R) ?-
Inter = [Min..PB],
Goal = in_intervals_reif(Type,A,Inter,R)
; Goal = gt_int_reif(B,A,R))),
+*/
+ Goal = gt_int_reif(B,A,R),
make_conj(CAB,Goal,Cstr)
; (R == 1 ->
make_conj(CA,CB,CAB),
@@ -2374,6 +2354,7 @@ unfold_int_expr(EA #=< EB,D,Cstr,Type0,R) ?-
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
make_conj(CA,CB,CAB),
+/*
((nonvar(Type),
Type \== int)
->
@@ -2383,7 +2364,8 @@ unfold_int_expr(EA #=< EB,D,Cstr,Type0,R) ?-
US = s),
intN_min_max(US,Size,Min,Max)
; true),
- ((nonvar(Min),
+ ((%Type == int,
+ nonvar(Min),
(number(A),C = A;
number(EA),to_int(Type,EA,C)),
var(B))
@@ -2391,7 +2373,8 @@ unfold_int_expr(EA #=< EB,D,Cstr,Type0,R) ?-
% CA =< B
Inter = [C..Max],
Goal = in_intervals_reif(Type,B,Inter,R)
- ; ((nonvar(Min),
+ ; ((%Type == int,
+ nonvar(Min),
(number(B),C = B;
number(EB),to_int(Type,EB,C)),
var(A))
@@ -2400,6 +2383,8 @@ unfold_int_expr(EA #=< EB,D,Cstr,Type0,R) ?-
Inter = [Min..C],
Goal = in_intervals_reif(Type,A,Inter,R)
; Goal = geq_int_reif(B,A,R))),
+*/
+ Goal = geq_int_reif(B,A,R),
make_conj(CAB,Goal,Cstr)
; (R == 1 ->
make_conj(CA,CB,CAB),
@@ -2621,7 +2606,7 @@ unfold_int_expr(EA $< EB,D,Cstr,Type0,R) ?-
int_vars(bool,R),
insert_dep_inst(dep(R,D,[A,B])),
(var(R) ->
- get_reif_var_depth_from_labchoice(DD),
+ %get_reif_var_depth_from_labchoice(DD),
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
min_max_lazy(Type,Min,Max,_),
@@ -2849,7 +2834,7 @@ unfold_int_expr((EA and EB),D,Cstr,Type,R) ?-
% on ignore EB
blocked_unify(R=0),
Cstr = CA
- ; % A == 0
+ ; % A == 1
unfold_int_expr(EB,ND,CB,Type,R),
make_conj(CA,CB,Cstr))
; unfold_int_expr(EB,ND,CB,Type,B),!,
@@ -2858,17 +2843,17 @@ unfold_int_expr((EA and EB),D,Cstr,Type,R) ?-
% on ignore EA
blocked_unify(R=0),
Cstr = CB
- ; % B == 0
+ ; % B == 1
blocked_unify(R=A),
make_conj(CA,CB,Cstr))
; int_vars(bool,R),
insert_dep_inst(dep(R,D,[A,B])),
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
- ((is_intervals_def(CA,TA,VA,IA,BA,RestA),
- is_intervals_def(CB,TB,VB,IB,BB,RestB),
+ ((TA \== real,
+ is_intervals_def(CA,TA,VA,IA,BA,RestA),
+ is_intervals_def(CB,_TB,VB,IB,BB,RestB),
VA == VB,
- %TA \== real,
var(BA),
var(BB))
->
@@ -2923,10 +2908,10 @@ unfold_int_expr((EA or EB),D,Cstr,Type,R) ?-
insert_dep_inst(dep(R,D,[A,B])),
insert_dep_inst(dep(A,D,[R])),
insert_dep_inst(dep(B,D,[R])),
- ((is_intervals_def(CA,TA,VA,IA,BA,RestA),
- is_intervals_def(CB,TB,VB,IB,BB,RestB),
+ ((TA \== real,
+ is_intervals_def(CA,TA,VA,IA,BA,RestA),
+ is_intervals_def(CB,_TB,VB,IB,BB,RestB),
VA == VB,
- %TA \== real,
var(BA),
var(BB))
->
@@ -3065,7 +3050,7 @@ unfold_int_expr(chk_nan(Cond,Then,Else),D,Cstr,Type,R) ?-
unfold_int_expr(isNaN(ERF),D,Cstr,Type,R) ?- !,
ND is D + 1,
Type = bool,
- unfold_real_expr(ERF,ND,C,RType,RF),
+ unfold_real_expr(ERF,ND,C,_RType,RF),
!,
(check_not_NaN(RF) ->
Cstr = C,
@@ -3322,6 +3307,7 @@ unfold_int_expr(fp_to_sbv(Rnd0,Size,EA),D,Cstr,Type,R) ?-
make_conj(CRndCA,RndCA,BegCond),
make_conj(BegCond,Cond,ACond),
make_conj(ACond,chk_undef_float_to_sbv(Bool,TypeF,Size,RndA,R),Cstr).
+
unfold_int_expr(uninterp(Term),D,Cstr,Type,R) ?- !,
nonvar(Term),
Term =.. [F|ArgsTypes],
@@ -3336,13 +3322,14 @@ unfold_int_expr(uninterp(Term),D,Cstr,Type,R) ?- !,
SetType = int_vars(TypeArg,AR)
; unfold_real_expr(Arg,D,AC,TypeArg,AR),
SetType = real_vars(TypeArg,AR)),
- make_conj(IC,(SetType,AC),OC)),
+ (ground(AR) ->
+ make_conj(IC,AC,OC)
+ ; make_conj(IC,(SetType,AC),OC))),
!,
- %int_vars(Type,R),
insert_dep_inst(dep(R,D,IArgs)),
make_conj(ACstrs,(int_vars(Type,R),uninterp_trigger(F,Types,Type,Trigger),uninterp(F,Trigger,Types,Type,IArgs,R)),Cstr).
-unfold_int_expr(Val,D,Cstr,Type,R) :-
+unfold_int_expr(Val,_D,Cstr,Type,R) :-
atomic(Val),
nonvar(Type),
(Type == rnd ->
@@ -3355,7 +3342,7 @@ unfold_int_expr(Val,D,Cstr,Type,R) :-
Cstr = true,
blocked_unify(R,Val).
-unfold_int_expr(Expr,D,Cstr,Type,R) :-
+unfold_int_expr(Expr,_D,_Cstr,_Type,_R) :-
call(spy_here)@eclipse,
writeln(error,"Syntax error on integer/boolean/sort expression":Expr),
exit_block(syntax).
@@ -3366,12 +3353,7 @@ unfold_let(From,[],E,D,Cstrs,Cstr,Type,R) :-
(From == int ->
unfold_int_expr(E,D,CstrE,Type,R)
; unfold_real_expr(E,D,CstrE,Type,R)),
- ((getval(check_sat_vars,1)@eclipse,
- CstrE == true)
- ->
- % Cstrs inutile ?
- Cstr = true
- ; make_conj(Cstrs,CstrE,Cstr)).
+ make_conj(Cstrs,CstrE,Cstr).
unfold_let(From,[(V,TypeV,EV)|T],E,D,Cstrs,Cstr,Type,R) :-
(var(TypeV) ->
exit_block(syntax)
@@ -3399,6 +3381,8 @@ get_reif_var_depth_from_labchoice(D) :-
bvnot_expr(Size,bvnot(Size,EA),E) ?- !,
E = EA.
*/
+%bvnot_expr(_,_,_) :- !,fail.
+
bvnot_expr(Size,bvand(Size,EA,EB),E) ?- !,
E = bvor(Size,bvnot(Size,EA),bvnot(Size,EB)).
bvnot_expr(Size,bvor(Size,EA,EB),E) ?- !,
@@ -3408,6 +3392,8 @@ bvnot_expr(1,as(0,_),R) ?- !,
bvnot_expr(1,as(1,_),R) ?- !,
blocked_unify(R,0).
+%not_expr(_,_) :- !,fail.
+
not_expr(0,B) ?- !,
blocked_unify(B,1).
not_expr(1,B) ?- !,
@@ -3487,18 +3473,47 @@ not_expr(alldiff(Type,[A,B]),E) ?-
%% Contraintes reifiees sur les entiers et booleens
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% PAS DE real !!!
+in_intervals_reif(Type,Var,Inter0,1) ?- !,
+ functor(Type,FType,_),
+ (occurs(FType,(float_simple,float_double)) ->
+ (Inter0 = [0.0] ->
+ Inter = [-0.0..0.0]
+ ; Inter = Inter0),
+ NType = FType
+ ; set_int_type(Type,Var),
+ Int = 1,
+ Inter = Inter0),
+ (nonvar(Int) ->
+ mfd:set_intervals(Var,Inter)
+ ; set_typed_intervals(Var,NType,Inter)).
+
+in_intervals_reif(Type,Var,Inter0,0) ?- !,
+ functor(Type,FType,_),
+ (occurs(FType,(float_simple,float_double)) ->
+ (Inter0 = [0.0] ->
+ Inter = [-0.0..0.0]
+ ; Inter = Inter0),
+ NType = Type
+ ; NType = int,
+ Inter = Inter0),
+ (NType == int ->
+ set_int_type(Type,Dummy),
+ mfd:get_intervals(Dummy,InitInter),
+ intervals_difference(InitInter,Inter,Diff),
+ mfd:set_intervals(Var,Diff)
+ ; finterval_difference(NType,[-1.0Inf .. 1.0Inf],Inter,Diff),
+ set_typed_intervals(Var,NType,Diff)).
in_intervals_reif(Type,Var,Inter0,Bool) :-
get_priority(Prio),
set_priority(1),
save_cstr_suspensions(Var),
functor(Type,FType,_),
- (occurs(FType,(real,float_simple,float_double)) ->
+ (occurs(FType,(float_simple,float_double)) ->
set_real_type(Type,Var),
mreal:get_intervals(Var,IVar),
- ((Type \== real,
- Inter0 = [0.0])
- ->
+ (Inter0 = [0.0] ->
Inter = [-0.0..0.0]
; Inter = Inter0),
T = Type
@@ -3520,17 +3535,6 @@ in_intervals_reif(Type,Var,Inter0,Bool) :-
(OpCom == [] ->
protected_unify(Bool = 1)
; true)),
- ((Type == real,
- Inter = [Val],
- float(Val))
- ->
- (Var == Val ->
- protected_unify(Bool = 1)
- ; (diff_real_value(Var,Val) ->
- protected_unify(Bool = 0),
- DiffVal = 1
- ; true))
- ; true),
(nonvar(Bool) ->
(Bool == 1 ->
(nonvar(Int) ->
@@ -3551,9 +3555,13 @@ in_intervals_reif(Type,Var,Inter0,Bool) :-
; finterval_difference(Type,[-1.0Inf .. 1.0Inf],Inter,Diff)),
set_typed_intervals(Var,Type,Diff))))
; get_saved_cstr_suspensions(LSusp),
- ((member((Susp,in_intervals_reif(Type,VVar,Com,BBool)),LSusp),
+ ((member((_Susp,in_intervals_reif(Type1,VVar,Com,BBool)),LSusp),
VVar == Var)
->
+ (Type == Type1 ->
+ true
+ ; % attention aux bveq !
+ call(spy_here)@eclipse),
protected_unify(Bool,BBool)
; my_suspend(in_intervals_reif(Type,Var,Com,Bool),0,(Var,Bool)->
suspend:constrained))),
@@ -3601,6 +3609,8 @@ is_intervals_def((R,eq_int_reif(Type,X,Y,Bool)),T,V,I,B,Rest) ?-
T = Type,
B = Bool,
Rest = R.
+
+/* DANGER en real sauf real_int ?
is_intervals_def(eq_real_reif(real,X,Y,Bool),T,V,I,B,Rest) ?-
(number(X) ->
var(Y),
@@ -3628,6 +3638,8 @@ is_intervals_def((R,eq_real_reif(real,X,Y,Bool)),T,V,I,B,Rest) ?-
T = real,
B = Bool,
Rest = R.
+*/
+
intervals_union(Type,Inter1,Inter2,Union) :-
functor(Type,FType,_),
(occurs(FType,(real,float_simple,float_double)) ->
@@ -3694,10 +3706,11 @@ diff_int_reif(A,B,Bool) :-
not_int(NotBool,Bool))).
-check_alldiffint_card(Bool,Kill,L) :-
+check_alldiffint_card(_Bool,_Kill,_L) :-
+ fail,
getval(check_sat_vars,1)@eclipse,
!.
-check_alldiffint_card(0,Kill,L) ?- !.
+check_alldiffint_card(0,_Kill,_L) ?- !.
check_alldiffint_card(Bool,Kill,L) :-
(length(L) < 3 ->
true
@@ -3783,9 +3796,9 @@ alldiff_reif(Type,L,Bool) :-
alldiff_reif1(Type,Kill,Depth,NL,Bool).
% Pas necessaire si enum ?
-alldiff_reif0(Mod,sort(_),L,NL) ?- !,
+alldiff_reif0(_Mod,sort(_),L,NL) ?- !,
NL = L.
-alldiff_reif0(Mod,array(_,_),L,NL) ?- !,
+alldiff_reif0(_Mod,array(_,_),L,NL) ?- !,
NL = L.
alldiff_reif0(Mod,Type,L,NewL) :-
((member_begin_end(Val,L,NL,End,End),
@@ -3833,11 +3846,11 @@ check_zero_remove_element(mreal,Type,Var,Val) :- !,
get_next_zero(Type,0.0,NZ) ?- !,
get_next_float(Type,0.0,NZ).
-get_next_zero(Type,-0.0,NZ) ?- !,
+get_next_zero(_Type,-0.0,NZ) ?- !,
NZ = 0.0.
get_previous_zero(Type,-0.0,NZ) ?- !,
get_previous_float(Type,-0.0,NZ).
-get_previous_zero(Type,0.0,NZ) ?- !,
+get_previous_zero(_Type,0.0,NZ) ?- !,
NZ = -0.0.
alldiff_reif1(_,0,_,_,Bool) ?- !,
@@ -3879,7 +3892,7 @@ alldiff_reif(Type,Kill,Depth,A,[B|L],Bool) :- !,
% le distinct de la smtlib
-diff_reif(_,Kill,A,B,Bool) :-
+diff_reif(_,Kill,_A,_B,Bool) :-
nonvar(Kill),
!,
protected_unify(Bool,0).
@@ -3887,19 +3900,19 @@ diff_reif(Type,Kill,A,B,Bool) :-
Type = array(_,_),
!,
diff_reif_array(Type,Kill,A,B,Bool).
-diff_reif(Type,Kill,A,A,Bool) ?- !,
+diff_reif(_Type,Kill,A,A,Bool) ?- !,
protected_unify(Kill,0),
protected_unify(Bool,0).
-diff_reif(Type,Kill,A,B,0) ?- !,
+diff_reif(_Type,Kill,A,B,0) ?- !,
protected_unify(Kill,0),
protected_unify(A,B).
-diff_reif(Type,Kill,A,B,Bool) :-
+diff_reif(_Type,_Kill,A,B,Bool) :-
ground(A),
ground(B),
!,
% A \== B,
protected_unify(Bool,1).
-diff_reif(Type,Kill,A,B,1) ?- !,
+diff_reif(Type,_Kill,A,B,1) ?- !,
((Type = sort(Sort);
Type == rnd, Sort = rnd)
->
@@ -3935,7 +3948,7 @@ diff_reif(Type,Kill,A,B,Bool) :- !,
; my_suspend(diff_reif(Type,Kill,A,B,Bool),0,(Kill,A,B,Bool)->suspend:constrained))).
-diff_real_chk_nan(Type,A,A) ?- !,
+diff_real_chk_nan(_Type,A,A) ?- !,
fail.
diff_real_chk_nan(real_int,A,B) :- !,
real_vars(real_int,[A,B]),
@@ -4030,8 +4043,13 @@ get_array_start(storec(A,_,_),Start) :-
get_array_start(A,Start).
+/*
+eval_select(Type,A,I,E,Start,Cstr) :- !,
+ get_array_start(A,Start),
+ Cstr = smtlib_select(Type,A,I,E).
+*/
% Evaluation partielle de select
-eval_select(Type,const_array(TI,TE,Const),I,E,Start,Cstr) ?- !,
+eval_select(_Type,const_array(TI,TE,Const),_I,E,Start,Cstr) ?- !,
Start = const_array(TI,TE,Const),
Cstr = true,
(TE = array(_,_) ->
@@ -4056,10 +4074,10 @@ eval_select(Type,A,I,E,Start,true) :-
smtlib_select(array(TypeI,TypeE),A,I,E) :-
(real_type(TypeI,_) ->
real_vars(real_int,I)
- ; let_int_vars(TypeI,I)),
+ ; int_vars(TypeI,I)),
(real_type(TypeE,_) ->
real_vars(TypeE,E)
- ; let_int_vars(TypeE,E)),
+ ; int_vars(TypeE,E)),
smtlib_select(A,A,I,E,TypeI,TypeE).
smtlib_select(A,Start,I,E,TypeI,TypeE) :-
@@ -4078,7 +4096,7 @@ smtlib_select(A,Start,I,E,TypeI,TypeE) :-
smtlib_select_bis(A,I,E,TypeI,TypeE) :-
% on ignore tous les indices non unifiables
- smtlib_select0(array(TypeI,TypeE),A,I,E,[],VarsI,NewA,NStart,Suspend),
+ smtlib_select0(array(TypeI,TypeE),A,I,E,[],_VarsI,NewA,NStart,Suspend),
(var(Suspend) ->
true
; once (get_saved_cstr_suspensions(LSusp);
@@ -4089,12 +4107,12 @@ smtlib_select_bis(A,I,E,TypeI,TypeE) :-
LS \== [])
->
NewA = storec(_,J,v(_,EJ,_)),
- (Type \= array(_,_) ->
+ (TypeE \= array(_,_) ->
SuspVars = [NStart,I,J,E,EJ]
; SuspVars = [NStart,I,J]),
check_before_suspend_select(NewA,NStart,I,E,TypeI,TypeE,SuspVars,LSusp)
; % on est bloque par I et le premier store
- NewA = storec(Array,J,v(_,VEJ,CEJ)),
+ NewA = storec(_Array,J,v(_,_VEJ,_CEJ)),
int_vars(bool,Bool),
diff_reif(TypeI,_,I,J,Bool),
(nonvar(Bool) ->
@@ -4108,6 +4126,7 @@ smtlib_select_bis(A,I,E,TypeI,TypeE) :-
insert_dep_inst(dep(I,Depth,[Bool,J,E,NStart])),
insert_dep_inst(dep(J,Depth,[Bool,I,E,NStart])),
SuspVars = [Bool,NStart],
+ %SuspVars = [Bool,NStart,I,J,E],
check_before_suspend_select(NewA,NStart,I,E,TypeI,TypeE,SuspVars,LSusp)))).
@@ -4117,18 +4136,11 @@ check_before_suspend_select(NewA,NStart,I,E,TypeI,TypeE,SuspVars,LSusp) :-
NStart == NNStart,
NewA == NNewA)
->
- ((TypeE \= array(_,_);
- var(E);
- var(EE))
- ->
+ (TypeE \= array(_,_) ->
protected_unify(E,EE)
- ; % TypeE = array(_,_) et nonvar E et EE
+ ; % TypeE = array(_,_)
call(spy_here)@eclipse,
- check_eq_array(TypeE,E,EE),
- Suspend = 1)
- ; Suspend = 1),
- (var(Suspend) ->
- true
+ check_eq_array(TypeE,E,EE))
; my_suspend(smtlib_select(NewA,NStart,I,E,TypeI,TypeE),4,SuspVars->suspend:constrained)).
@@ -4139,8 +4151,7 @@ check_before_suspend_select(NewA,NStart,I,E,TypeI,TypeE,SuspVars,LSusp) :-
% - VarsE contient les valeurs pointees par VarsI
% - NewA est le nouveau array ne contenant que des indices
% unifiables avec I
-smtlib_select0(Type,const_array(TI,TE,Const),I,E,SeenI,VarsI,
- NewA,Start,Suspend)
+smtlib_select0(_Type,const_array(TI,TE,Const),_I,E,SeenI,VarsI,NewA,Start,Suspend)
?- !,
VarsI = SeenI,
(SeenI == [] ->
@@ -4161,10 +4172,7 @@ smtlib_select0(Type,storec(A,J,EJ),I,E,SeenI,VarsI,NewA,Start,Suspend) ?- !,
% I variable ou bien Ground = 0
(SeenI == [] ->
% on a fini
- ((var(E);
- var(VEJ);
- TypeE \= array(_,_))
- ->
+ (TypeE \= array(_,_) ->
protected_unify(E,VEJ)
; check_eq_array(TypeE,E,VEJ)),
call(CstrEJ)
@@ -4188,13 +4196,29 @@ smtlib_select0(array(TI,TE),A,I,E,SeenI,SeenI,A,Start,Suspend) :-
% A est variable, pas d'indice connu unifiable
% on peut ajouter (I,E) et la contrainte est resolue
array_vars(TI,TE,Start),
- NewA = storec(Start,I,v(u,E,true)),
% Pour les autres select
- A = NewA
- ; NewA = A,
- Start = A,
+ (occurs(A,E) ->
+ call(spy_here)@eclipse,
+ % On lance les contraintes dans E qui contiennent A
+ launch_elt_cstrs_with_A(A,E,NE),
+ protected_unify(A,storec(Start,I,v(u,NE,true)))
+ ; protected_unify(A,storec(Start,I,v(u,E,true))))
+ ; Start = A,
Suspend = 1).
+launch_elt_cstrs_with_A(A,storec(B,I,v(V,VEI,CstrEI)),NB) ?- !,
+ ((var(A),
+ occurs(A,CstrEI))
+ ->
+ call(CstrEI),
+ NB = storec(ENB,I,v(V,VEI,true))
+ ; NB = storec(ENB,I,v(V,VEI,CstrEI))),
+ launch_elt_cstrs_with_A(A,B,ENB).
+launch_elt_cstrs_with_A(_A,B,NB) :-
+ % var(B)
+ protected_unify(B,NB).
+
+
check_seen_upper_index(J,SeenI) :-
((var(J);
atom(J);
@@ -4207,11 +4231,11 @@ check_seen_upper_index(J,SeenI) :-
-diff_reif_array(Type,Kill,A,B,Bool) :-
+diff_reif_array(_Type,Kill,_A,_B,Bool) :-
nonvar(Kill),
!,
protected_unify(Bool,0).
-diff_reif_array(Type,Kill,A,A,Bool) ?- !,
+diff_reif_array(_Type,Kill,A,A,Bool) ?- !,
Kill = 0,
protected_unify(Bool,0).
diff_reif_array(Type,Kill,A,B,Bool) :-
@@ -4245,7 +4269,8 @@ diff_reif_array(Type,Kill,A,B,Bool) :-
; % <>
%diff_array(Type,A1,B1),
protected_unify(Bool,1))
- ; my_suspend(diff_reif_array(Type,Kill,A1,B1,Bool),4,[Bool->suspend:inst,(A1,B1)->suspend:constrained])))))).
+% ; my_suspend(diff_reif_array(Type,Kill,A1,B1,Bool),4,[Bool->suspend:inst,(A1,B1)->suspend:constrained])))))).
+ ; my_suspend(diff_reif_array(Type,Kill,A1,B1,Bool),4,[Bool->suspend:inst])))))).
eq_array(_,A,A) ?- !.
@@ -4293,8 +4318,8 @@ check_eq_array(Type,Seen,storec(A,I,v(_,ValA,CstrA)),
ValA == ValB)
->
true
- ; ((var(ValA);
- var(ValB);
+ ; (((var(ValA);
+ var(ValB)),
TypeE \= array(_,_))
->
protected_unify(ValA,ValB)
@@ -4304,23 +4329,23 @@ check_eq_array(Type,Seen,storec(A,I,v(_,ValA,CstrA)),
hash_set(Seen,I,1),
check_eq_array(Type,Seen,A,B).
check_eq_array(_,_,A,A) ?- !.
-check_eq_array(Type,Seen,const_array(TI,TE,Const),A) ?- !,
+check_eq_array(Type,_Seen,const_array(_TI,_TE,Const),A) ?- !,
check_eq_const_array(Type,Const,A).
-check_eq_array(Type,Seen,A,const_array(TI,TE,Const)) ?- !,
+check_eq_array(Type,_Seen,A,const_array(_TI,_TE,Const)) ?- !,
check_eq_const_array(Type,Const,A).
check_eq_array(Type,Seen,A,B) :-
hash_create(HA),
hash_create(HB),
eq_array(Type,_,A,B,(Seen,[]),(HA,[]),(HB,[])).
-check_eq_const_array(Type,Const,B) :-
+check_eq_const_array(_Type,Const,B) :-
var(B),
!,
protected_unify(B,Const).
-check_eq_const_array(Type,Const,const_array(TI,TE,CB)) ?-
+check_eq_const_array(_Type,Const,const_array(_TI,_TE,CB)) ?-
!,
protected_unify(Const,CB).
-check_eq_const_array(Type,Const,storec(B,I,v(_,ValB,CstrB))) ?-
+check_eq_const_array(Type,Const,storec(B,_I,v(_,ValB,CstrB))) ?-
!,
protected_unify(Const,ValB),
call(CstrB),
@@ -4374,8 +4399,8 @@ eq_array(Type,Diff,A,B,Seen,SureA,SureB) :-
eq_clean_array(Type,Diff,A,B,Seen,SureA,SureB) :-
% Seen contient tout les index sures de A ou B
% sur lesquels on a lance des select dans A ou B
- eq_array0(Type,Diff,A,B,NA,IA,Seen,SureA,Seen1,Work),
- eq_array0(Type,Diff,B,A,NB,IB,Seen1,SureB,NSeen,Work),
+ eq_array0(Type,Diff,A,B,NA,_IA,Seen,SureA,Seen1,Work),
+ eq_array0(Type,Diff,B,A,NB,_IB,Seen1,SureB,NSeen,Work),
(nonvar(Work) ->
% on a lancee des select qui ont pu modifier
% A ou B, SureA ou Sure B
@@ -4420,7 +4445,7 @@ eq_clean_array(Type,Diff,A,B,Seen,SureA,SureB) :-
; (length(IAs) >= length(IBs) ->
IAs = [I,J|_]
; IBs = [I,J|_]),
- Type = array(TI,TE),
+ Type = array(TI,_TE),
int_vars(bool,Bool),
diff_reif(TI,_,I,J,Bool),
(nonvar(Bool) ->
@@ -4441,7 +4466,7 @@ exists_sub_diff_array(Type,A,B,NA,NB,StartA,StartB) :-
(var(StartA) ->
delayed_goals(StartA,DGA)
; DGA = []),
- once (member(diff_array1(Type,X,Y,SureX,SureY),DGA),
+ once (member(diff_array1(Type,X,Y,_SureX,_SureY),DGA),
get_array_start(X,StartX),
get_array_start(Y,StartY),
(StartA == StartX ->
@@ -4459,7 +4484,7 @@ exists_sub_eq_array(Type,A,B,NA,NB,StartA,StartB) :-
(var(StartA) ->
delayed_goals(StartA,DGA)
; DGA = []),
- once (member(eq_array(Type,_,X,Y,_,SureX,SureY),DGA),
+ once (member(eq_array(Type,_,X,Y,_,_SureX,_SureY),DGA),
get_array_start(X,StartX),
get_array_start(Y,StartY),
(StartA == StartX ->
@@ -4480,7 +4505,7 @@ is_sub_array(storec(SA,IA,EA),storec(A,IB,EB),StartA,NewA) ?- !,
; nonvar(A),
NewA = storec(ENewA,IB,EB),
is_sub_array(storec(SA,IA,EA),A,StartA,ENewA)).
-is_sub_array(SA,A,StartA,NewA) :-
+is_sub_array(SA,_A,StartA,NewA) :-
var(SA),
SA == StartA,
NewA = StartA.
@@ -4501,7 +4526,7 @@ same_sure_indexes(SureA,SureB,DiffA,DiffB) :-
Out = [(I,E)|In])),
(foreach((I,E),LA),
fromto(GIAs,In,Out,DiffA),
- param(NSureB,NSureA) do
+ param(NSureB) do
(sure_index(NSureB,I) ->
Out = In
; Out = [(I,E)|In])),
@@ -4514,7 +4539,7 @@ same_sure_indexes(SureA,SureB,DiffA,DiffB) :-
Out = [(I,E)|In])),
(foreach((I,E),LB),
fromto(GIBs,In,Out,DiffB),
- param(NSureB,NSureA) do
+ param(NSureA) do
(sure_index(NSureA,I) ->
Out = In
; Out = [(I,E)|In])).
@@ -4714,13 +4739,13 @@ eq_array0(Type,Diff,storec(A,I,v(FI,EI,CEI)),B,NA,IA,Seen,SureA,NSeen,Work) ?- !
NA = storec(A,I,v(FI,EI,CEI)),
IA = [I],
NSeen = Seen)).
-eq_array0(_,_,A,B,A,[],Seen,_,Seen,_).
+eq_array0(_,_,A,_B,A,[],Seen,_,Seen,_).
-diff_array(Type,A,A) ?- !,
+diff_array(_Type,A,A) ?- !,
fail.
-diff_array(Type,const_array(TI,TE,A),const_array(TI,TE,B)) ?- !,
+diff_array(_Type,const_array(TI,TE,A),const_array(TI,TE,B)) ?- !,
A \== B.
diff_array(Type,const_array(TI,TE,Const),A) ?- !,
(real_type(TI,_) ->
@@ -4763,10 +4788,10 @@ diff_array(Type,A,B) :-
set_priority(P),
wake_if_other_scheduled(P).
-diff_array1(Type,const_array(TI,TE,A),const_array(TI,TE,B),_,_) ?- !,
+diff_array1(_Type,const_array(TI,TE,A),const_array(TI,TE,B),_,_) ?- !,
A \== B.
-diff_array1(Type,const_array(TI,TE,Const),A,_,_) ?- !,
- smtlib_select(Type,A,I,E),
+diff_array1(Type,const_array(_TI,TE,Const),A,_,_) ?- !,
+ smtlib_select(Type,A,_I,E),
diff_reif(TE,_,E,Const,1).
diff_array1(Type,A,const_array(TI,TE,Const),_,_) ?- !,
diff_array1(Type,const_array(TI,TE,Const),A,_,_).
@@ -4898,7 +4923,7 @@ select_diff_array(Type,I,A,B) :-
ite_diff_array(Type,EA,EB,NA,NB,SureA,SureB) :-
% CA et CB propagees car index sur
- Type = array(TI,TE),
+ Type = array(_TI,TE),
int_vars(bool,[Bool,Bool1]),
(real_type(TE,_) ->
real_vars(TE,[EA,EB])
@@ -4952,7 +4977,7 @@ diff_from_common_indexes(TI,I,SureA,SureB) :-
param(TI,I) do
diff_reif(TI,_,I,J,1)).
-find_unsure_index(storec(A,J,E),Sure,Is) ?-
+find_unsure_index(storec(A,J,_E),Sure,Is) ?-
(sure_index(Sure,J) ->
find_unsure_index(A,Sure,Is)
; Sure = (H,L),
@@ -5006,7 +5031,7 @@ find_non_equal_common_sures(SureA,SureB,LEAB) :-
OutAB = [I,EA,EB|InAB]
; OutAB = InAB)).
-remove_common_stores(A,B,SureA,SureB,NA,NB,Diff) :-
+remove_common_stores(A,B,_SureA,_SureB,NA,NB,Diff) :-
nonvar(Diff),
!,
NA = A,
@@ -5026,7 +5051,7 @@ check_common_sures(_,_,Diff) :-
!.
check_common_sures(SureA,SureB,Diff) :-
SureA = (HA,LA),
- hash_list(HA,LIA,LEA),
+ hash_list(HA,LIA,_LEA),
(((member(IA,LIA);
member((IA,_),LA)),
get_sure_index(SureA,IA,EA),
@@ -5040,8 +5065,7 @@ check_common_sures(SureA,SureB,Diff) :-
remove_common_stores0(A,_,_,NA) :-
var(A),
!,
- NA = A,
- NSeenA = SeenA.
+ NA = A.
remove_common_stores0(const_array(TI,TE,Const),_,_,NA) :- !,
NA = const_array(TI,TE,Const).
remove_common_stores0(storec(A,IA,v(_,EA,CEA)),SureA,SureB,NA) :-
@@ -5066,7 +5090,7 @@ check_diff_array(_,const_array(_,_,CA),const_array(_,_,CB)) ?- !,
not_unify(CA,CB).
check_diff_array(TE,const_array(_,_,Const),A) ?- !,
hash_create(HA),
- clean_array(A,NA,(HA,[]),SureA),
+ clean_array(A,_NA,(HA,[]),SureA),
SureA = (_,LA),
hash_list(HA,GIAs,_),
once ((member(I,GIAs);
@@ -5080,8 +5104,8 @@ check_diff_array(TE,A,const_array(_,_,Const)) ?- !,
check_diff_array(TE,A,B) :-
hash_create(HA),
hash_create(HB),
- clean_array(A,NA,(HA,[]),SureA),
- clean_array(B,NB,(HB,[]),SureB),
+ clean_array(A,_NA,(HA,[]),SureA),
+ clean_array(B,_NB,(HB,[]),SureB),
SureA = (_,LA),
hash_list(HA,GIAs,_),
once ((member(I,GIAs);
@@ -5157,7 +5181,7 @@ check_exists_gt_int_reif([Susp|LSusp],A,B,Bool) :-
(A,B) == (U,V))
->
kill_suspension(Susp),
- Bool = Bool1
+ protected_unify(Bool,Bool1)
; check_exists_gt_int_reif(LSusp,A,B,Bool))
; check_exists_gt_int_reif(LSusp,A,B,Bool)).
@@ -5312,115 +5336,6 @@ imply_reif(A,B,C) :-
launch_ineq(=<,B,C),
geq_int_reif(B,A,C).
-/*
-and_seq_reif(A,CB,A,C) ?- !,
- protected_unify(A=C),
- call(CB).
-and_seq_reif(A,CB,B,1) ?- !,
- protected_unify(A = 1),
- protected_unify(B = 1),
- call(CB).
-and_seq_reif(A,CB,B,C) :-
- nonvar(A),!,
- (A == 0 ->
- protected_unify(C = 0)
- ; % A == 1
- protected_unify(B = C),
- call(CB)).
-and_seq_reif(A,CB,B,C) :-
- nonvar(B),!,
- % B a ete propage ?
- call(CB),
- (B == 0 ->
- protected_unify(C = 0)
- ; % B == 1
- A = C).
-and_seq_reif(A,CB,B,C) :-
- (CB == true ->
- and_reif(A,B,C)
- ; % Exploitation des identites
- save_cstr_suspensions((A,B)),
- (exists_diff_Rel(A,C) ->
- protected_unify(C = 0),
- protected_unify(A = 1),
- protected_unify(B = 0),
- call(CB)
- ; (get_type(B,_) ->
- % B a ete propage
- (exists_diff_Rel(B,C) ->
- protected_unify(C = 0),
- protected_unify(B = 1),
- protected_unify(A = 0),
- call(CB)
- ; (exists_diff_Rel(A,B) ->
- protected_unify(C = 0),
- call(CB)
- ; get_saved_cstr_suspensions(LSusp),
- ((member((_,and_seq_reif(X,CY,Y,Z)),LSusp),
- (A,B) == (X,Y))
- ->
- % Factorisation
- protected_unify(Z = C)
- ; my_suspend(and_seq_reif(A,CB,B,C),3,
- (A,B,C) -> suspend:constrained))))
- ; my_suspend(and_seq_reif(A,CB,B,C),3,
- (A,C) -> suspend:constrained)))).
-
-
-
-or_seq_reif(A,CB,A,C) ?- !,
- protected_unify(A=C),
- call(CB).
-or_seq_reif(A,CB,B,0) ?- !,
- protected_unify(A = 0),
- protected_unify(B = 0),
- call(CB).
-or_seq_reif(A,CB,B,C) :-
- nonvar(A),!,
- (A == 1 ->
- protected_unify(C = 1)
- ; % A == 0
- protected_unify(B = C),
- call(CB)).
-or_seq_reif(A,CB,B,C) :-
- nonvar(B),!,
- % B a ete propage
- call(CB),
- (B == 1 ->
- protected_unify(C = 1)
- ; % B == 0
- protected_unify(A = C)).
-or_seq_reif(A,CB,B,C) :-
- (CB == true ->
- or_reif(A,B,C)
- ; % Exploitation des identites
- save_cstr_suspensions((A,B)),
- (exists_diff_Rel(A,C) ->
- protected_unify(C = 1),
- protected_unify(A = 0),
- protected_unify(B = 1),
- call(CB)
- ; (get_type(B,_) ->
- % B a ete propage
- (exists_diff_Rel(B,C) ->
- protected_unify(C = 1),
- protected_unify(B = 0),
- protected_unify(A = 1),
- call(CB)
- ; (exists_diff_Rel(A,B) ->
- protected_unify(C = 1),
- call(CB)
- ; get_saved_cstr_suspensions(LSusp),
- ((member((_,or_seq_reif(X,CY,Y,Z)),LSusp),
- (A,B) == (X,Y))
- ->
- % Factorisation
- protected_unify(Z = C)
- ; my_suspend(or_seq_reif(A,CB,B,C),3,
- (A,B,C) -> suspend:constrained))))
- ; my_suspend(or_seq_reif(A,CB,B,C),3,
- (A,C) -> suspend:constrained)))).
-*/
get_bool_var_type(V,Type) :-
var(V),
@@ -5437,23 +5352,19 @@ get_bool_var_type(Num,Type) :-
; occurs(Type,(int,bool))).
-%% ESSAI
-%chk_nan_reif(Cond,_,_,0) ?- !,
-% kill_useless_cond(Cond).
-
-chk_nan_reif(Cond,(1,CT),(RE,CE),0) ?- !,
+chk_nan_reif(Cond,(1,_CT),(RE,CE),0) ?- !,
protected_unify(Cond,0),
protected_unify(RE,0),
call(CE).
-chk_nan_reif(Cond,(0,CT),(RE,CE),1) ?- !,
+chk_nan_reif(Cond,(0,_CT),(RE,CE),1) ?- !,
protected_unify(Cond,0),
protected_unify(RE,1),
call(CE).
-chk_nan_reif(Cond,(RT,CT),(1,CE),0) ?- !,
+chk_nan_reif(Cond,(RT,CT),(1,_CE),0) ?- !,
protected_unify(Cond,1),
protected_unify(RT,0),
call(CT).
-chk_nan_reif(Cond,(RT,CT),(0,CE),1) ?- !,
+chk_nan_reif(Cond,(RT,CT),(0,_CE),1) ?- !,
protected_unify(Cond,1),
protected_unify(RT,1),
call(CT).
@@ -5500,7 +5411,7 @@ unify_check_array(A,B) :-
(A = storec(AA,_,_) ->
get_array_type(AA,Type),
check_eq_array(Type,A,B)
- ; (A = const_array(TI,TE,Const) ->
+ ; (A = const_array(TI,TE,_Const) ->
check_eq_array(array(TI,TE),A,B)
; protected_unify(A,B))).
@@ -5520,7 +5431,7 @@ ite_reif(Cond,(0,true),(1,true),R) ?-
get_bool_var_type(R,Type),
!,
not_int(Cond,R).
-ite_reif(Cond,(V,true),(V,true),R) ?- !,
+ite_reif(_Cond,(V,true),(V,true),R) ?- !,
unify_check_array(V,R).
ite_reif(Cond,(RT,CT),(RE,CE),R) :-
get_priority(P),
@@ -5589,8 +5500,7 @@ try_simplif_ite_reif0(Prio,Cond,(RT,CT),(RE,CE),R,Work) :-
setval(refutation_chk,1)@eclipse,
(not (protected_unify(Cond,1),
protected_unify(R,RT),
- call(CT),
- copy_term(RT,CRT))
+ call(CT))
->
Work = 1,
setval(refutation_chk,0)@eclipse,
@@ -5600,8 +5510,7 @@ try_simplif_ite_reif0(Prio,Cond,(RT,CT),(RE,CE),R,Work) :-
call(CE)
; (not (protected_unify(Cond,0),
protected_unify(R,RE),
- call(CE),
- copy_term(RE,CRE))
+ call(CE))
->
Work = 1,
setval(refutation_chk,0)@eclipse,
@@ -5719,7 +5628,7 @@ isNaN(F,R) :-
protected_unify(R,0)
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((Susp,isNaN(FF,RR)),LS),
+ ((member((_Susp,isNaN(FF,RR)),LS),
F == FF)
->
protected_unify(R,RR)
@@ -5738,13 +5647,13 @@ isFinite(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,Inter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
% Attention, pas dans la smtlib
-isFinite(Type,nan,Bool) ?- !,
+isFinite(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isFinite(Type,F,Bool) :-
get_priority(Prio),
@@ -5757,7 +5666,7 @@ isFinite(Type,F,Bool) :-
mreal: set_typed_intervals(F,Type,[-1.0Inf,1.0Inf]))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((Susp,isFinite(Type,FF,BBool)),LS),
+ ((member((_Susp,isFinite(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -5784,7 +5693,7 @@ isFinite(Type,F,Bool) :-
isInfinite(Type,F) :-
mreal:set_typed_intervals(F,Type,[-1.0Inf,1.0Inf]),
ensure_not_NaN(F).
-isInfinite(Type,nan,Bool) ?- !,
+isInfinite(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isInfinite(Type,F,Bool) :-
get_priority(Prio),
@@ -5799,7 +5708,7 @@ isInfinite(Type,F,Bool) :-
mreal:set_typed_intervals(F,Type,[MinF..MaxF]))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((Susp,isInfinite(Type,FF,BBool)),LS),
+ ((member((_Susp,isInfinite(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -5825,11 +5734,11 @@ isZero(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,[-0.0..0.0],_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
-isNotZero(Type,nan) ?- !.
+isNotZero(_Type,nan) ?- !.
isNotZero(Type,F) :-
set_lazy_domain(Type,F),
get_float_epsilon(Type,Eps),
@@ -5839,11 +5748,11 @@ isNotZero(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,OpInter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
-isZero(Type,nan,Bool) ?- !,
+isZero(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isZero(Type,F,Bool) :-
get_priority(Prio),
@@ -5855,7 +5764,7 @@ isZero(Type,F,Bool) :-
; isNotZero(Type,F))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((Susp,isZero(Type,FF,BBool)),LS),
+ ((member((_Susp,isZero(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -5863,7 +5772,7 @@ isZero(Type,F,Bool) :-
get_float_epsilon(Type,Eps),
OpEps is -Eps,
OpInter = [-1.0Inf..OpEps,Eps..1.0Inf],
- (not mreal:dom_intersection(Dom,dom(Type,OpInter,_),NDom,_) ->
+ (not mreal:dom_intersection(Dom,dom(Type,OpInter,_),_NDom,_) ->
(check_not_NaN(F) ->
protected_unify(Bool,1)
; Suspend = 1)
@@ -5888,11 +5797,11 @@ isNormal(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,Inter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
-isNormal(Type,nan,Bool) ?- !,
+isNormal(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isNormal(Type,F,Bool) :-
get_priority(Prio),
@@ -5904,7 +5813,7 @@ isNormal(Type,F,Bool) :-
; isNotNormal(Type,F))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((S,isNormal(Type,FF,BBool)),LS),
+ ((member((_S,isNormal(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -5930,7 +5839,7 @@ isNormal(Type,F,Bool) :-
set_priority(Prio),
wake_if_other_scheduled(Prio).
-isNotNormal(Type,nan) ?- !.
+isNotNormal(_Type,nan) ?- !.
isNotNormal(Type,F) :-
set_lazy_domain(Type,F),
min_normalized(Type,Min),
@@ -5941,7 +5850,7 @@ isNotNormal(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,Inter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
@@ -5959,11 +5868,11 @@ isSubnormal(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,Inter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
-isSubnormal(Type,nan,Bool) ?- !,
+isSubnormal(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isSubnormal(Type,F,Bool) :-
get_priority(Prio),
@@ -5975,7 +5884,7 @@ isSubnormal(Type,F,Bool) :-
; isNotSubnormal(Type,F))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((Susp,isSubnormal(Type,FF,BBool)),LS),
+ ((member((_Susp,isSubnormal(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -6001,7 +5910,7 @@ isSubnormal(Type,F,Bool) :-
set_priority(Prio),
wake_if_other_scheduled(Prio).
-isNotSubnormal(Type,nan) ?- !.
+isNotSubnormal(_Type,nan) ?- !.
isNotSubnormal(Type,F) :-
set_lazy_domain(Type,F),
min_normalized(Type,Min),
@@ -6011,7 +5920,7 @@ isNotSubnormal(Type,F) :-
mreal:dom_intersection(Dom,dom(Type,Inter,_),NDom,_),
(NDom == Dom ->
true
- ; NDom = dom(_,NInter,S),
+ ; NDom = dom(_,NInter,_S),
set_typed_intervals(F,Type,NInter),
my_notify_constrained(F),
wake).
@@ -6020,7 +5929,7 @@ isPositive(Type,F) :-
set_lazy_domain(Type,F),
ensure_not_NaN(F),
set_sign(Type,F,pos).
-isPositive(Type,nan,Bool) ?- !,
+isPositive(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isPositive(Type,F,Bool) :-
get_priority(Prio),
@@ -6033,7 +5942,7 @@ isPositive(Type,F,Bool) :-
set_sign(Type,F,neg))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((S,isPositive(Type,FF,BBool)),LS),
+ ((member((_S,isPositive(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -6055,7 +5964,7 @@ isNegative(Type,F) :-
set_lazy_domain(Type,F),
ensure_not_NaN(F),
set_sign(Type,F,neg).
-isNegative(Type,nan,Bool) ?- !,
+isNegative(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isNegative(Type,F,Bool) :-
get_priority(Prio),
@@ -6068,7 +5977,7 @@ isNegative(Type,F,Bool) :-
set_sign(Type,F,pos))
; save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((S,isNegative(Type,FF,BBool)),LS),
+ ((member((_S,isNegative(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -6089,7 +5998,7 @@ isIntegral(Type,F) :-
set_lazy_domain(Type,F),
ensure_not_NaN(F),
launch_float_int_number(F).
-isIntegral(Type,nan,Bool) ?- !,
+isIntegral(_Type,nan,Bool) ?- !,
protected_unify(Bool,0).
isIntegral(Type,F,Bool) :-
get_priority(Prio),
@@ -6111,7 +6020,7 @@ isIntegral(Type,F,Bool) :-
; Suspend = 1)))),
save_cstr_suspensions(F),
get_saved_cstr_suspensions(LS),
- ((member((S,isIntegral(Type,FF,BBool)),LS),
+ ((member((_S,isIntegral(Type,FF,BBool)),LS),
F == FF)
->
protected_unify(Bool,BBool)
@@ -6129,7 +6038,6 @@ integrals([V|LV]) :-
truncate(V,V)
; var(V),
insert_dep_inst(inst_cstr(0,V)),
- insert_dep_inst(dep(V,1,[I])),
% on regarde float_eval
set_check_lazy_domain(real,V),
launch_float_int_number(V)),
@@ -6190,13 +6098,13 @@ to_real(Type,X,FX) :-
to_real1(real,X,FX) ?- !,
norm_zero(real,X,FX).
-to_real1(Type,nan,FX) ?- !,
+to_real1(_Type,nan,FX) ?- !,
FX = nan.
to_real1(float_simple,X,FX) ?- !,
cast_double_to_simple_float(X,FX).
to_real1(_,X,X).
-unfold_real_expr(X,D,Cstr,Type,R) :-
+unfold_real_expr(X,_D,Cstr,Type,R) :-
var(X),
!,
((get_type(X,Type);
@@ -6273,7 +6181,7 @@ unfold_real_expr(IX,_,Cstr,Type,X) :-
RX is rational(IX),
real_from_rat(RX,X0),
blocked_unify(X,X0).
-unfold_real_expr(realString(Str),D,Cstr,Type,R) ?-
+unfold_real_expr(realString(Str),_D,Cstr,Type,R) ?-
string(Str),
(var(Type) ->
Type = real
@@ -6293,7 +6201,12 @@ unfold_real_expr(select(EA,EI), D, Cstr, Type, R) ?-
ND is D + 1,
unfold_int_expr(EA,ND,CA,TA,A),
nonvar(TA),
- TA = array(TI,Type),
+ TA = array(TI,Type0),
+ ((nonvar(Type),
+ real_type(Type,real))
+ ->
+ real_type(Type0,real)
+ ; Type = Type0),
(real_type(TI,_) ->
% pour les real_int
unfold_real_expr(EI,ND,CI,TI,I),
@@ -6736,11 +6649,27 @@ unfold_real_expr(EA + EB,D,Cstr,Type,R) ?-
unfold_real_expr(EA,ND,CA,Type,A),
unfold_real_expr(EB,ND,CB,Type,B),
!,
- insert_dep_inst(dep(R,D,[A,B])),
- make_conj(CA,CB,CAB),
- (real_type(Type,real) ->
- make_conj(CAB,add_real(real,A,B,R),Cstr)
- ; make_conj(CAB,(ensure_not_NaN((A,B,R)),add_real(Type,A,B,R)),Cstr))).
+ ((fail,nonvar(Type),
+ real_type(Type,real),
+ ((CA = (PC,op_real(_,Op,_));
+ CA = op_real(_,Op,_),
+ PC = true),
+ X = B,
+ make_conj(PC,CB,CAB);
+ (CB = (PC,op_real(_,Op,_));
+ CB = op_real(_,Op,_),
+ PC = true),
+ X = A,
+ make_conj(CA,PC,CAB)))
+ ->
+ %call(spy_here)@eclipse,
+ make_conj(CAB,minus_real(real,X,Op,R),Cstr),
+ insert_dep_inst(dep(R,D,[X,Op]))
+ ; insert_dep_inst(dep(R,D,[A,B])),
+ make_conj(CA,CB,CAB),
+ (real_type(Type,real) ->
+ make_conj(CAB,add_real(real,A,B,R),Cstr)
+ ; make_conj(CAB,(ensure_not_NaN((A,B,R)),add_real(Type,A,B,R)),Cstr)))).
unfold_real_expr(fp_add(EA,EB),D,Cstr,Type,R) ?-
!,
unfold_real_expr(fp_add(rne,EA,EB),D,Cstr,Type,R).
@@ -6804,11 +6733,33 @@ unfold_real_expr(EA - EB,D,Cstr,Type,R) ?-
unfold_real_expr(EA,ND,CA,Type,A),
unfold_real_expr(EB,ND,CB,Type,B),
!,
- insert_dep_inst(dep(R,D,[A,B])),
- make_conj(CA,CB,CAB),
- (real_type(Type,real) ->
- make_conj(CAB,minus_real(real,A,B,R),Cstr)
- ; make_conj(CAB,(ensure_not_NaN((A,B,R)),minus_real(Type,A,B,R)),Cstr))).
+ ((fail,nonvar(Type),
+ real_type(Type,real),
+ ((CA = (PC,op_real(_,Op,_));
+ CA = op_real(_,Op,_),
+ PC = true),
+ X = B,
+ make_conj(PC,CB,CAB),
+ % -Op - X -> -(X + Op)
+ Goal = (add_real(real,X,Op,XpOp),op_real(real,XpOp,R)),
+ insert_dep_inst(XpOp,D,[X,Op]),
+ insert_dep_inst(R,D,[XpOp]);
+ (CB = (PC,op_real(_,Op,_));
+ CB = op_real(_,Op,_),
+ PC = true),
+ X = A,
+ make_conj(CA,PC,CAB),
+ % X - (-Op) -> X + Op
+ Goal = add_real(real,X,Op,R),
+ insert_dep_inst(R,D,[X,Op])))
+ ->
+ %call(spy_here)@eclipse,
+ make_conj(CAB,Goal,Cstr)
+ ; insert_dep_inst(dep(R,D,[A,B])),
+ make_conj(CA,CB,CAB),
+ (real_type(Type,real) ->
+ make_conj(CAB,minus_real(real,A,B,R),Cstr)
+ ; make_conj(CAB,(ensure_not_NaN((A,B,R)),minus_real(Type,A,B,R)),Cstr)))).
unfold_real_expr(fp_sub(EA,EB),D,Cstr,Type,R) ?-
!,
unfold_real_expr(fp_sub(rne,EA,EB),D,Cstr,Type,R).
@@ -6871,11 +6822,27 @@ unfold_real_expr(EA * EB,D,Cstr,Type,R) ?-
unfold_real_expr(NEA,ND,CA,Type,A),
unfold_real_expr(NEB,ND,CB,Type,B),
!,
- insert_dep_inst(dep(R,D,[A,B])),
make_conj(CA,CB,CAB),
- (real_type(Type,real) ->
- make_conj(CAB,mult_real(real,A,B,R),Cstr)
- ; make_conj(CAB,(ensure_not_NaN((A,B,R)),mult_real(Type,A,B,R)),Cstr)).
+ ((nonvar(Type),
+ real_type(Type,real),
+ (occurs(A,(-1.0,0.0,1.0)),
+ Cst = A, X = B;
+ occurs(B,(-1.0,0.0,1.0)),
+ Cst = B, X = A))
+ ->
+ %call(spy_here)@eclipse,
+ (Cst == 0.0 ->
+ Cstr = CAB,
+ blocked_unify(R,0.0)
+ ; (Cst == 1.0 ->
+ Cstr = CAB,
+ blocked_unify(R,X)
+ ; % -1
+ make_conj(CAB,op_real(real,X,R),Cstr)))
+ ; insert_dep_inst(dep(R,D,[A,B])),
+ (real_type(Type,real) ->
+ make_conj(CAB,mult_real(real,A,B,R),Cstr)
+ ; make_conj(CAB,(ensure_not_NaN((A,B,R)),mult_real(Type,A,B,R)),Cstr))).
unfold_real_expr(fp_mul(EA,EB),D,Cstr,Type,R) ?- !,
unfold_real_expr(fp_mul(rne,EA,EB),D,Cstr,Type,R).
unfold_real_expr(fp_mul(Rnd0,EA,EB),D,Cstr,Type,R) ?-
@@ -7254,7 +7221,7 @@ unfold_real_expr(fp_fma(Rnd0,EA,EB,EC),D,Cstr,Type,R) ?-
unfold_real_expr(EA ^ EN,D,Cstr,RType,R) ?-
ND is D + 1,
unfold_real_expr(EA,ND,CA,RType,A),
- unfold_int_expr(EN,ND,CN,Type1,N),
+ unfold_int_expr(EN,ND,CN,_Type1,N),
nonvar(RType),
real_type(RType,Type),
!,
@@ -7264,7 +7231,7 @@ unfold_real_expr(EA ^ EN,D,Cstr,RType,R) ?-
% seulement rne, EN est un entier >= 0
unfold_real_expr(fp_power(EA,EN),D,Cstr,Type,R) ?-
ND is D + 1,
- unfold_int_expr(EN,ND,_,Type1,N),
+ unfold_int_expr(EN,ND,_,_Type1,N),
integer(N),
N >= 0,
(N == 0 ->
@@ -7451,7 +7418,7 @@ unfold_real_expr(ite(Cond,Then,Else),D,Cstr,RType,R) ?-
unfold_real_expr(Then,ND,CT,RType,RT),
unfold_real_expr(Else,ND,CE,RType,RE),
nonvar(RType),
- real_type(RType,Type),
+ real_type(RType,_Type),
!,
get_reif_var_depth_from_labchoice(DD),
insert_dep_inst(inst_cstr(DD,RCond)),
@@ -7475,8 +7442,8 @@ unfold_real_expr(uninterp(Term),D,Cstr,Type,R) ?- !,
nonvar(Term),
Term =.. [F|ArgsTypes],
(foreach(as(Arg,TypeArg),ArgsTypes),
- foreach(AR,IArgs),
foreach(TypeArg,Types),
+ foreach(AR,IArgs),
fromto(true,IC,OC,ACstrs),
param(D) do
functor(TypeArg,T,_),
@@ -7485,7 +7452,9 @@ unfold_real_expr(uninterp(Term),D,Cstr,Type,R) ?- !,
SetType = int_vars(TypeArg,AR)
; unfold_real_expr(Arg,D,AC,TypeArg,AR),
SetType = real_vars(TypeArg,AR)),
- make_conj(IC,(SetType,AC),OC)),
+ (ground(AR) ->
+ make_conj(IC,AC,OC)
+ ; make_conj(IC,(SetType,AC),OC))),
!,
insert_dep_inst(dep(R,D,IArgs)),
make_conj(ACstrs,(real_vars(Type,R),uninterp_trigger(F,Types,Type,Trigger),uninterp(F,Trigger,Types,Type,IArgs,R)),Cstr).
@@ -7514,13 +7483,13 @@ get_real_cst(Rat,Var) :-
float_to_double(0,Rnd,A,R) ?- !,
ensure_not_NaN([A,R]),
cast_float_to_double(Rnd,A,R).
-float_to_double(1,Rnd,A,R) ?- !,
+float_to_double(1,_Rnd,A,R) ?- !,
protected_unify(A,nan),
protected_unify(R,nan).
-float_to_double(Cond,Rnd,nan,R) ?- !,
+float_to_double(Cond,_Rnd,nan,R) ?- !,
protected_unify(R,nan),
protected_unify(Cond,1).
-float_to_double(Cond,Rnd,A,nan) ?- !,
+float_to_double(Cond,_Rnd,A,nan) ?- !,
protected_unify(A,nan),
protected_unify(Cond,1).
float_to_double(Cond,Rnd,A,R) :-
@@ -7532,7 +7501,7 @@ float_to_double(Cond,Rnd,A,R) :-
float_to_double(Cond,Rnd,A,R) :-
save_cstr_suspensions((A,R)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,float_to_double(Cond1,RRnd,AA,RR)),LSusp),
+ ((member((_S,float_to_double(Cond1,RRnd,AA,RR)),LSusp),
RRnd == Rnd,
A == AA)
->
@@ -7543,13 +7512,13 @@ float_to_double(Cond,Rnd,A,R) :-
double_to_float(0,Rnd,A,R) ?- !,
ensure_not_NaN([A,R]),
cast_double_to_float(Rnd,A,R).
-double_to_float(1,Rnd,A,R) ?- !,
+double_to_float(1,_Rnd,A,R) ?- !,
protected_unify(A,nan),
protected_unify(R,nan).
-double_to_float(Cond,Rnd,nan,R) ?- !,
+double_to_float(Cond,_Rnd,nan,R) ?- !,
protected_unify(R,nan),
protected_unify(Cond,1).
-double_to_float(Cond,Rnd,A,nan) ?- !,
+double_to_float(Cond,_Rnd,A,nan) ?- !,
protected_unify(A,nan),
protected_unify(Cond,1).
double_to_float(Cond,Rnd,A,R) :-
@@ -7561,7 +7530,7 @@ double_to_float(Cond,Rnd,A,R) :-
double_to_float(Cond,Rnd,A,R) :-
save_cstr_suspensions((A,R)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,double_to_float(Cond1,RRnd,AA,RR)),LSusp),
+ ((member((_S,double_to_float(Cond1,RRnd,AA,RR)),LSusp),
RRnd == Rnd,
A == AA)
->
@@ -7572,13 +7541,13 @@ double_to_float(Cond,Rnd,A,R) :-
fp_neg(0,Type,A,R) ?- !,
ensure_not_NaN([A,R]),
op_real(Type,A,R).
-fp_neg(1,Type,NaN,R) ?- !,
+fp_neg(1,_Type,A,R) ?- !,
protected_unify(A,nan),
protected_unify(R,nan).
-fp_neg(Cond,Type,nan,R) ?- !,
+fp_neg(Cond,_Type,nan,R) ?- !,
protected_unify(Cond,1),
protected_unify(R,nan).
-fp_neg(Cond,Type,A,nan) ?- !,
+fp_neg(Cond,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_neg(Cond,Type,A,R) :-
@@ -7601,9 +7570,10 @@ fp_neg(Cond,Type,A,R) :-
fp_round(0,Rnd,Type,A,R) ?- !,
ensure_not_NaN(R),
round(Rnd,Type,A,R).
-fp_round(1,Rnd,Type,NaN,R) ?- !,
+fp_round(1,_Rnd,_Type,A,R) ?- !,
+ protected_unify(A,nan),
protected_unify(R,nan).
-fp_round(Cond,Rnd,Type,A,nan) ?- !,
+fp_round(Cond,_Rnd,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_round(Cond,Rnd,Type,A,R) :-
@@ -7625,9 +7595,10 @@ fp_round(Cond,Rnd,Type,A,R) :-
fp_truncate(0,Type,A,R) ?- !,
ensure_not_NaN(R),
truncate(Type,A,R).
-fp_truncate(1,Type,NaN,R) ?- !,
+fp_truncate(1,_Type,A,R) ?- !,
+ protected_unify(A,nan),
protected_unify(R,nan).
-fp_truncate(Cond,Type,A,nan) ?- !,
+fp_truncate(Cond,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_truncate(Cond,Type,A,R) :-
@@ -7648,9 +7619,10 @@ fp_truncate(Cond,Type,A,R) :-
fp_floor(0,Type,A,R) ?- !,
ensure_not_NaN(R),
floor(Type,A,R).
-fp_floor(1,Type,NaN,R) ?- !,
+fp_floor(1,_Type,A,R) ?- !,
+ protected_unify(A,nan),
protected_unify(R,nan).
-fp_floor(Cond,Type,A,nan) ?- !,
+fp_floor(Cond,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_floor(Cond,Type,A,R) :-
@@ -7671,9 +7643,10 @@ fp_floor(Cond,Type,A,R) :-
fp_ceiling(0,Type,A,R) ?- !,
ensure_not_NaN(R),
ceiling(Type,A,R).
-fp_ceiling(1,Type,NaN,R) ?- !,
+fp_ceiling(1,_Type,A,R) ?- !,
+ protected_unify(A,nan),
protected_unify(R,nan).
-fp_ceiling(Cond,Type,A,nan) ?- !,
+fp_ceiling(Cond,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_ceiling(Cond,Type,A,R) :-
@@ -7695,10 +7668,10 @@ fp_abs(0,Type,A,R) ?- !,
ensure_not_NaN(A),
ensure_not_NaN(R),
abs_val_real(Type,A,R).
-fp_abs(1,Type,A,R) ?- !,
+fp_abs(1,_Type,A,R) ?- !,
protected_unify(A,nan),
protected_unify(R,nan).
-fp_abs(Cond,Type,A,nan) ?- !,
+fp_abs(Cond,_Type,A,nan) ?- !,
protected_unify(Cond,1),
protected_unify(A,nan).
fp_abs(Cond,Type,A,R) :-
@@ -7717,19 +7690,19 @@ fp_abs(Cond,Type,A,R) :-
protected_unify(R,RR)
; my_suspend(fp_abs(Cond,Type,A,R),0,(Cond,A,R)->suspend:constrained)).
-fp_add(1,Rnd,Type,A,B,R) ?- !,
+fp_add(1,_Rnd,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
fp_add(0,Rnd,Type,A,B,R) ?- !,
ensure_not_NaN(R),
ensure_not_NaN((A,B)),
fp_add(Rnd,Type,A,B,R).
-fp_add(Cond,Rnd,Type,nan,B,R) ?- !,
+fp_add(Cond,_Rnd,_Type,nan,_B,R) ?- !,
protected_unify(Cond,1),
protected_unify(R,nan).
-fp_add(Cond,Rnd,Type,A,nan,R) ?- !,
+fp_add(Cond,_Rnd,_Type,_A,nan,R) ?- !,
protected_unify(Cond,1),
protected_unify(R,nan).
-fp_add(Cond,Rnd,Type,A,B,nan) ?- !,
+fp_add(Cond,_Rnd,_Type,_A,_B,nan) ?- !,
protected_unify(Cond,1).
fp_add(Cond,Rnd,Type,A,B,R) :-
check_not_NaN(R),
@@ -7759,7 +7732,7 @@ fp_add(Cond,Rnd,Type,A,B,nan) ?- !,
true
; save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_add(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_add(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
Rnd == Rnd1,
(A == X ->
B == Y
@@ -7775,7 +7748,7 @@ fp_add(Cond,Rnd,Type,A,B,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once (Goal = fp_add(Cond1,Rnd1,Type,X,Y,Z),
Rnd == Rnd1;
Rnd == rne,
@@ -7832,7 +7805,7 @@ fp_add_rnd(Rnd,Type,A,B,R) :-
kill_suspension(S),
protected_unify(R,Z)
; true),
- ((member((NS,op_real1(Type,X,Y)),LS),
+ ((member((_NS,op_real1(Type,X,Y)),LS),
(A == X ->
B == Y
; A == Y,
@@ -7841,7 +7814,7 @@ fp_add_rnd(Rnd,Type,A,B,R) :-
(Rnd == rtn ->
protected_unify(A,-0.0)
; protected_unify(R,0.0))
- ; Continue0 = 1),
+ ; true),
(not_inf_bounds(R) ->
forbid_infinities(Type,[A,B])
; true),
@@ -7881,7 +7854,7 @@ fp_add_dir(Rnd,Type,A,B,R) :-
fp_add_interval(Rnd,Type,LA,HA,LB,HB,LR,HR),
set_typed_intervals(R,Type,[LR..HR]).
-fp_add_inv(Rnd,Type,B,R,A) :-
+fp_add_inv(_Rnd,Type,B,R,A) :-
dvar_range(Type,B,LB,HB),
dvar_range(Type,R,LR,HR),
get_previous_float(Type,LR,NLR),
@@ -7894,12 +7867,12 @@ fp_add_interval(Rnd,Type,LA,HA,LB,HB,LR,HR) :-
fp_add_val(Rnd,Type,LA,LB,LR),
fp_add_val(Rnd,Type,HA,HB,HR).
-fp_add_inst(Rnd,Type,1.0Inf,B,R,Continue) ?- !,
+fp_add_inst(_Rnd,_Type,1.0Inf,B,R,_Continue) ?- !,
mreal:dvar_remove_element(B,-1.0Inf),
protected_unify(R,1.0Inf).
fp_add_inst(Rnd,Type,A,1.0Inf,R,Continue) ?- !,
fp_add_inst(Rnd,Type,1.0Inf,A,R,Continue).
-fp_add_inst(Rnd,Type,-1.0Inf,B,R,Continue) ?- !,
+fp_add_inst(_Rnd,_Type,-1.0Inf,B,R,_Continue) ?- !,
mreal:dvar_remove_element(B,1.0Inf),
protected_unify(R,-1.0Inf).
fp_add_inst(Rnd,Type,A,-1.0Inf,R,Continue) ?- !,
@@ -7956,17 +7929,17 @@ fp_add_inst0(Rnd,Type,A,B,R,Continue) :-
; Continue = 1)).
-fp_add_val(Rnd,Type,A,B,R) :-
+fp_add_val(Rnd,_Type,_A,_B,_R) :-
var(Rnd),
!,
exit_block(fp_add_val_variable_rnd).
-fp_add_val(Rnd,Type,-1.0Inf,B,R) ?- !,
+fp_add_val(_Rnd,_Type,-1.0Inf,_B,R) ?- !,
protected_unify(R,-1.0Inf).
-fp_add_val(Rnd,Type,1.0Inf,B,R) ?- !,
+fp_add_val(_Rnd,_Type,1.0Inf,_B,R) ?- !,
protected_unify(R,1.0Inf).
-fp_add_val(Rnd,Type,A,-1.0Inf,R) ?- !,
+fp_add_val(_Rnd,_Type,_A,-1.0Inf,R) ?- !,
protected_unify(R,-1.0Inf).
-fp_add_val(Rnd,Type,A,1.0Inf,R) ?- !,
+fp_add_val(_Rnd,_Type,_A,1.0Inf,R) ?- !,
protected_unify(R,1.0Inf).
fp_add_val(Rnd,Type,A,B,R) :-
make_OCamlRat(A,RA),
@@ -7985,6 +7958,8 @@ fp_add_val(Rnd,Type,A,B,R) :-
; protected_unify(R,0.0))).
+
+
/** inhibited because remove to much constraints */
kill_useless_cond(Bool) :- !.
@@ -8024,15 +7999,15 @@ kill_useless_cond(Bool,chk_nan_reif(Bool1,_,_,Bool),S) ?- !,
kill_useless_cond(_,_,_).
-fp_sub(1,Rnd,Type,A,B,R) ?- !,
+fp_sub(1,_Rnd,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
fp_sub(0,Rnd,Type,A,B,R) ?- !,
ensure_not_NaN((A,B,R)),
fp_sub(Rnd,Type,A,B,R).
-fp_sub(Cond,Rnd,Type,nan,B,R) ?- !,
+fp_sub(Cond,_Rnd,_Type,nan,_B,R) ?- !,
protected_unify(Cond,1),
protected_unify(R,nan).
-fp_sub(Cond,Rnd,Type,A,nan,R) ?- !,
+fp_sub(Cond,_Rnd,_Type,_A,nan,R) ?- !,
protected_unify(Cond,1),
protected_unify(R,nan).
fp_sub(Cond,Rnd,Type,A,B,R) :-
@@ -8065,7 +8040,7 @@ fp_sub(Cond,Rnd,Type,A,B,nan) ?- !,
true
; save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_sub(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_sub(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
Rnd == Rnd1,
A == X,
B == Y)
@@ -8079,7 +8054,7 @@ fp_sub(Cond,Rnd,Type,A,B,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_sub(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_sub(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
Rnd == Rnd1,
A == X,
B == Y)
@@ -8169,16 +8144,16 @@ fp_sub_interval(Rnd,Type,LA,HA,LB,HB,LR,HR) :-
OpHB is -HB,
fp_add_interval(Rnd,Type,LA,HA,OpHB,OpLB,LR,HR).
-fp_sub_inst(Rnd,Type,1.0Inf,B,R,Continue) ?- !,
+fp_sub_inst(_Rnd,_Type,1.0Inf,B,R,_Continue) ?- !,
mreal:dvar_remove_element(B,1.0Inf),
protected_unify(R,1.0Inf).
-fp_sub_inst(Rnd,Type,A,1.0Inf,R,Continue) ?- !,
+fp_sub_inst(_Rnd,_Type,A,1.0Inf,R,_Continue) ?- !,
mreal:dvar_remove_element(A,1.0Inf),
protected_unify(R,-1.0Inf).
-fp_sub_inst(Rnd,Type,-1.0Inf,B,R,Continue) ?- !,
+fp_sub_inst(_Rnd,_Type,-1.0Inf,B,R,_Continue) ?- !,
mreal:dvar_remove_element(B,-1.0Inf),
protected_unify(R,-1.0Inf).
-fp_sub_inst(Rnd,Type,A,-1.0Inf,R,Continue) ?- !,
+fp_sub_inst(_Rnd,_Type,A,-1.0Inf,R,_Continue) ?- !,
mreal:dvar_remove_element(A,-1.0Inf),
protected_unify(R,1.0Inf).
fp_sub_inst(Rnd,Type,A,B,R,Continue) :-
@@ -8214,12 +8189,12 @@ fp_sub_val(Rnd,Type,A,B,R) :-
fp_add_val(Rnd,Type,A,OpB,R)).
-fp_mul(1,Rnd,Type,A,B,R) ?- !,
+fp_mul(1,_Rnd,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
fp_mul(0,Rnd,Type,A,B,R) ?- !,
ensure_not_NaN(R),
fp_mul(Rnd,Type,A,B,R).
-fp_mul(Cond,Rnd,Type,A,B,nan) ?- !,
+fp_mul(Cond,_Rnd,_Type,_A,_B,nan) ?- !,
protected_unify(Cond,1).
fp_mul(Cond,Rnd,Type,A,B,R) :-
(check_not_NaN(R);
@@ -8228,7 +8203,7 @@ fp_mul(Cond,Rnd,Type,A,B,R) :-
!,
get_cstr_suspensions(Cond,LSusp),
((member(Susp,LSusp),
- get_suspension_data(Susp,goal,chk_nan_reif(Bool,T,E,CCond)),
+ get_suspension_data(Susp,goal,chk_nan_reif(Bool,_T,_E,CCond)),
Cond == CCond)
->
kill_suspension(Susp),
@@ -8264,7 +8239,7 @@ fp_mul(Cond,Rnd,Type,A,B,nan) ?- !,
true
; save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_mul(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_mul(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
Rnd == Rnd1,
(A == X ->
B == Y
@@ -8280,7 +8255,7 @@ fp_mul(Cond,Rnd,Type,A,B,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once (Goal = fp_mul(Cond1,Rnd1,Type,X,Y,Z),
Rnd == Rnd1;
Rnd == rne,
@@ -8325,7 +8300,7 @@ fp_mul_rnd(Rnd,Type,A,B,R) :-
% Seulement projection directe
save_cstr_suspensions((A,B,R)),
get_saved_cstr_suspensions(LS),
- ((member((S,fp_mul_rnd(Rnd1,Type,X,Y,Z)),LS),
+ ((member((_S,fp_mul_rnd(Rnd1,Type,X,Y,Z)),LS),
Rnd == Rnd1,
(X == A ->
Y == B
@@ -8385,25 +8360,25 @@ fp_square_interval(Rnd,Type,L,H,LR,HR) :-
LR = 0.0
; LR is min(B1,B2)).
-fp_mul_inst(Rnd,Type,0.0,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,Type,0.0,B,R,Continue) ?- !,
(get_sign(B,Sign) ->
(Sign == pos ->
protected_unify(R,0.0)
; protected_unify(R,-0.0))
; set_intervals(Type,R,[-0.0 .. 0.0]),
Continue = 1).
-fp_mul_inst(Rnd,Type,-0.0,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,Type,-0.0,B,R,Continue) ?- !,
(get_sign(B,Sign) ->
(Sign == pos ->
protected_unify(R,-0.0)
; protected_unify(R,0.0))
; set_intervals(Type,R,[-0.0 .. 0.0]),
Continue = 1).
-fp_mul_inst(Rnd,Type,1.0,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,_Type,1.0,B,R,_Continue) ?- !,
protected_unify(B,R).
-fp_mul_inst(Rnd,Type,-1.0,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,Type,-1.0,B,R,_Continue) ?- !,
op_real(Type,B,R).
-fp_mul_inst(Rnd,Type,1.0Inf,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,Type,1.0Inf,B,R,Continue) ?- !,
forbid_zero(Type,B),
(get_sign(B,Sign) ->
(Sign == pos ->
@@ -8411,7 +8386,7 @@ fp_mul_inst(Rnd,Type,1.0Inf,B,R,Continue) ?- !,
; protected_unify(R,-1.0Inf))
; set_intervals(Type,R,[-1.0Inf,1.0Inf]),
Continue = 1).
-fp_mul_inst(Rnd,Type,-1.0Inf,B,R,Continue) ?- !,
+fp_mul_inst(_Rnd,Type,-1.0Inf,B,R,Continue) ?- !,
forbid_zero(Type,B),
(get_sign(B,Sign) ->
(Sign == pos ->
@@ -8473,7 +8448,7 @@ fp_mul_interval(Rnd,Type,LA,HA,LB,HB,LR,HR) :-
fp_mul_val(Rnd,Type,HA,HB,H2),
sort(0,=<,[H1,H2],[_,HR]))))).
-fp_mul_val(Rnd,Type,A,B,R) :-
+fp_mul_val(_Rnd,_Type,A,B,R) :-
A =:= 0.0,
B =:= 0.0,
!,
@@ -8514,12 +8489,12 @@ fp_mul_val(rna,Type,A,B,R) ?- !,
; R is SR*1.0Inf).
-fp_div(1,Rnd,Type,A,B,R) ?- !,
+fp_div(1,_Rnd,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
fp_div(0,Rnd,Type,A,B,R) ?- !,
ensure_not_NaN(R),
fp_div(Rnd,Type,A,B,R).
-fp_div(Cond,Rnd,Type,A,B,nan) ?- !,
+fp_div(Cond,_Rnd,_Type,_A,_B,nan) ?- !,
protected_unify(Cond,1).
fp_div(Cond,Rnd,Type,A,B,R) :-
check_not_NaN(R),
@@ -8530,7 +8505,7 @@ fp_div(Cond,Rnd,Type,A,B,R) :-
get_saved_cstr_suspensions(LSusp),
protected_unify(Cond,0),
ensure_not_NaN((A,B)),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once (Goal = fp_div(Cond1,Rnd1,Type,X,Y,Z),
Rnd == Rnd1;
Rnd == rne,
@@ -8570,7 +8545,7 @@ fp_div(Cond,Rnd,Type,A,B,nan) ?- !,
true
; save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_div(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_div(Cond1,Rnd1,Type,X,Y,Z)),LSusp),
Rnd == Rnd1,
A == X,
B == Y)
@@ -8584,7 +8559,7 @@ fp_div(Cond,Rnd,Type,A,B,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once (Goal = fp_div(Cond1,Rnd1,Type,X,Y,Z),
Rnd == Rnd1;
Rnd == rne,
@@ -8621,7 +8596,7 @@ fp_div_rnd(Rnd,Type,A,B,R) :-
->
protected_unify(R,RR)
; my_suspend(fp_div_rnd(Rnd,Type,A,B,R),2,Rnd->suspend:inst)).
-fp_div_rnd(Rnd,Type,A,A,R) ?-
+fp_div_rnd(_Rnd,_Type,A,A,R) ?-
not_zero(A),
not_inf_bounds(A),
!,
@@ -8633,7 +8608,7 @@ fp_div_rnd(Rnd,Type,A,B,R) :-
% Seulement projection directe
save_cstr_suspensions((A,B,R)),
get_saved_cstr_suspensions(LS),
- ((member((S,fp_div_rnd(Rnd1,Type,X,Y,Z)),LS),
+ ((member((_S,fp_div_rnd(Rnd1,Type,X,Y,Z)),LS),
Rnd == Rnd1,
X == A,
Y == B)
@@ -8738,19 +8713,19 @@ fp_div_val(rna,Type,A,B,R) ?- !,
; R is SR*1.0Inf).
-fp_rem(1,Type,A,B,R) ?- !,
+fp_rem(1,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
fp_rem(0,Type,A,B,R) ?- !,
ensure_not_NaN(R),
fp_rem(Type,A,B,R).
-fp_rem(Cond,Type,A,B,nan) ?- !,
+fp_rem(Cond,_Type,_A,_B,nan) ?- !,
protected_unify(Cond,1).
fp_rem(Cond,Type,A,B,R) :-
check_not_NaN(R),
!,
get_cstr_suspensions(Cond,LSusp),
((member(Susp,LSusp),
- get_suspension_data(Susp,goal,chk_nan_reif(Bool,T,E,CCond)),
+ get_suspension_data(Susp,goal,chk_nan_reif(Bool,_T,_E,CCond)),
Cond == CCond)
->
kill_suspension(Susp),
@@ -8783,7 +8758,7 @@ fp_rem(Cond,Type,A,B,nan) ?- !,
true
; save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,fp_rem(Cond1,Type,X,Y,Z)),LSusp),
+ ((member((_S,fp_rem(Cond1,Type,X,Y,Z)),LSusp),
A == X,
B == Y)
->
@@ -8796,7 +8771,7 @@ fp_rem(Cond,Type,A,B,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once (Goal = fp_rem(Cond1,Type,X,Y,Z);
Goal = fp_rem1(Type,X,Y,Z), NotNaN = 1),
A == X,
@@ -8811,19 +8786,19 @@ fp_rem(Cond,Type,A,B,R) :-
-fp_fma(1,Rnd,Type,A,B,C,R) ?- !,
+fp_fma(1,_Rnd,_Type,_A,_B,_C,R) ?- !,
protected_unify(R,nan).
fp_fma(0,Rnd,Type,A,B,C,R) ?- !,
ensure_not_NaN(R),
fma(Rnd,Type,A,B,C,R).
-fp_fma(Cond,Rnd,Type,A,B,C,nan) ?- !,
+fp_fma(Cond,_Rnd,_Type,_A,_B,_C,nan) ?- !,
protected_unify(Cond,1).
fp_fma(Cond,Rnd,Type,A,B,C,R) :-
check_not_NaN(R),
!,
get_cstr_suspensions(Cond,LSusp),
((member(Susp,LSusp),
- get_suspension_data(Susp,goal,chk_nan_reif(Bool,T,E,CCond)),
+ get_suspension_data(Susp,goal,chk_nan_reif(Bool,_T,_E,CCond)),
Cond == CCond)
->
kill_suspension(Susp),
@@ -8839,7 +8814,7 @@ fp_fma(Cond,Rnd,Type,A,B,C,R) :-
set_lazy_domain(Type,R),
save_cstr_suspensions((A,B,C)),
get_saved_cstr_suspensions(LSusp),
- ((member((S,Goal),LSusp),
+ ((member((_S,Goal),LSusp),
once ((Goal = fp_fma(Cond1,Rnd1,Type,X,Y,Z,T);
Goal = fma1(Rnd1,Type,X,Y,Z,T), NotNaN = 1),
Rnd1 == Rnd),
@@ -8864,7 +8839,7 @@ fp_fma(Cond,Rnd,Type,A,B,C,R) :-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-fp_eq_reif(1,Type,A,B,Bool) ?- !,
+fp_eq_reif(1,_Type,_A,_B,Bool) ?- !,
protected_unify(Bool,0).
fp_eq_reif(0,Type,A,B,Bool) ?- !,
set_lazy_domain(Type,A),
@@ -8876,10 +8851,10 @@ fp_eq_reif(Cond,Type,A,B,1) ?- !,
set_lazy_domain(Type,A),
set_lazy_domain(Type,B),
fp_eq(Type,A,B).
-fp_eq_reif(Cond,Type,nan,B,Bool) ?- !,
+fp_eq_reif(Cond,_Type,nan,_B,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
-fp_eq_reif(Cond,Type,A,nan,Bool) ?- !,
+fp_eq_reif(Cond,_Type,_A,nan,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
fp_eq_reif(Cond,Type,A,B,Bool) :-
@@ -8925,7 +8900,7 @@ check_exists_fp_eq_reif(Cond,Type,A,B,Bool) :-
protected_unify(Bool,Bool1)
; true).
-fp_eq_reif(Type,A,A,Bool) ?- !,
+fp_eq_reif(_Type,A,A,Bool) ?- !,
protected_unify(Bool,1).
fp_eq_reif(Type,A,B,1) ?- !,
fp_eq(Type,A,B).
@@ -9120,9 +9095,9 @@ check_diff_congr(Type,A,B,div_real1(Type,AA,BA,A),
X = AA,
Y = AB
; true)).
-check_diff_congr(Type,A,B,GA,GB,Done,X,Y).
+check_diff_congr(_Type,_A,_B,_GA,_GB,_Done,_X,_Y).
-check_diff_congr_com(A,B,AA,BA,AB,BB,Done,X,Y) :-
+check_diff_congr_com(_A,_B,AA,BA,AB,BB,Done,X,Y) :-
(AA == AB ->
Done = 1,
X = BA,
@@ -9173,7 +9148,7 @@ refute_fp_diff_block(Type,A,B,Continue) :-
; Continue = 1,
setval(refutation_chk,0)@eclipse)).
-eq_real_reif(Type,A,A,Bool) ?- !,
+eq_real_reif(_Type,A,A,Bool) ?- !,
protected_unify(Bool,1).
eq_real_reif(Type,A,B,Bool) :-
set_lazy_domain(Type,A),
@@ -9191,8 +9166,6 @@ eq_real_reif(Type,A,B,Bool) :-
eq_real_reif_bis(Type,A,B,Bool) :-
get_priority(Prio),
set_priority(1),
- mreal:dvar_domain(A,DomA),
- mreal:dvar_domain(A,DomB),
check_exists_eq_real_reif(Type,A,B,Bool),
(var(Bool) ->
mfd:(Bool::[0,1]),
@@ -9234,7 +9207,7 @@ diff_real_reif(Type,A,B,Bool) :-
-fp_gt_reif(1,Type,A,B,Bool) ?- !,
+fp_gt_reif(1,_Type,_A,_B,Bool) ?- !,
protected_unify(Bool,0).
fp_gt_reif(0,Type,A,B,Bool) ?- !,
ensure_not_NaN([A,B]),
@@ -9243,10 +9216,10 @@ fp_gt_reif(Cond,Type,A,B,1) ?- !,
protected_unify(Cond,0),
ensure_not_NaN([A,B]),
launch_gt_real(Type,A,B).
-fp_gt_reif(Cond,Type,nan,B,Bool) ?- !,
+fp_gt_reif(Cond,_Type,nan,_B,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
-fp_gt_reif(Cond,Type,A,nan,Bool) ?- !,
+fp_gt_reif(Cond,_Type,_A,nan,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
fp_gt_reif(Cond,Type,A,B,Bool) :-
@@ -9260,19 +9233,11 @@ fp_gt_reif(Cond,Type,A,B,Bool) :-
set_priority(1),
set_lazy_domain(Type,A),
set_lazy_domain(Type,B),
- %get_rel_between_real_args(A,B,Rel),
- (fail,not occurs(Rel,(?,=)) ->
- ensure_not_NaN([A,B]),
- protected_unify(Cond,0),
- (occurs(Rel,(<,=<)) ->
- protected_unify(Bool,0),
- launch_geq_real(Type,B,A)
- ; gt_real_reif(Type,A,B,Bool))
- ; check_exists_fp_gt_reif(Cond,Type,A,B,Bool,Continue),
- (var(Continue) ->
- true
- ; my_suspend(fp_gt_reif(Cond,Type,A,B,Bool),0,
- (Cond,Bool,A,B) -> suspend:constrained))),
+ check_exists_fp_gt_reif(Cond,Type,A,B,Bool,Continue),
+ (var(Continue) ->
+ true
+ ; my_suspend(fp_gt_reif(Cond,Type,A,B,Bool),0,
+ (Cond,Bool,A,B) -> suspend:constrained)),
set_priority(Prio),
wake_if_other_scheduled(Prio).
@@ -9286,7 +9251,7 @@ check_exists_fp_gt_reif(Cond,Type,A,B,Bool,Continue) :-
protected_unify(Bool,Bool1)
; Continue = 1).
-fp_geq_reif(1,Type,A,B,Bool) ?- !,
+fp_geq_reif(1,_Type,_A,_B,Bool) ?- !,
protected_unify(Bool,0).
fp_geq_reif(0,Type,A,B,Bool) ?- !,
ensure_not_NaN([A,B]),
@@ -9295,10 +9260,10 @@ fp_geq_reif(Cond,Type,A,B,1) ?- !,
protected_unify(Cond,0),
ensure_not_NaN([A,B]),
launch_geq_real(Type,A,B).
-fp_geq_reif(Cond,Type,nan,B,Bool) ?- !,
+fp_geq_reif(Cond,_Type,nan,_B,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
-fp_geq_reif(Cond,Type,A,nan,Bool) ?- !,
+fp_geq_reif(Cond,_Type,_A,nan,Bool) ?- !,
protected_unify(Cond,1),
protected_unify(Bool,0).
fp_geq_reif(Cond,Type,A,B,Bool) :-
@@ -9314,25 +9279,17 @@ fp_geq_reif(Cond,Type,A,B,Bool) :-
mfd:(Bool:: [0,1]),
set_lazy_domain(Type,A),
set_lazy_domain(Type,B),
- %get_rel_between_real_args(A,B,Rel),
- (fail,not occurs(Rel,(?,=)) ->
- ensure_not_NaN([A,B]),
- protected_unify(Cond,0),
- (Rel == < ->
- protected_unify(Bool,0),
- launch_gt_real(Type,B,A)
- ; geq_real_reif(Type,A,B,Bool))
- ; check_exists_fp_geq_reif(Cond,Type,A,B,Bool,Continue),
- (var(Continue) ->
- true
- ; my_suspend(fp_geq_reif(Cond,Type,A,B,Bool),0,
- (Cond,Bool,A,B) -> suspend:constrained))),
+ check_exists_fp_geq_reif(Cond,Type,A,B,Bool,Continue),
+ (var(Continue) ->
+ true
+ ; my_suspend(fp_geq_reif(Cond,Type,A,B,Bool),0,
+ (Cond,Bool,A,B) -> suspend:constrained)),
set_priority(Prio),
wake_if_other_scheduled(Prio).
check_exists_fp_geq_reif(Cond,Type,A,B,Bool,Continue) :-
get_saved_cstr_suspensions(LSusp),
- ((member((Susp,fp_geq_reif(Cond1,Type,U,V,Bool1)),LSusp),
+ ((member((_Susp,fp_geq_reif(Cond1,Type,U,V,Bool1)),LSusp),
(A,B) == (U,V))
->
protected_unify(Cond,Cond1),
@@ -9348,7 +9305,19 @@ gt_real_reif(Type,A,B,Bool) :-
launch_gt_real(Type,A,B)
; % Bool = 0
launch_geq_real(Type,B,A))
- ; gt_real_reif_bis(Type,A,B,Bool))).
+ ; ((getval(check_sat_vars,1)@eclipse,
+ Type == real,
+ once (number(A),
+ rational(A,RA);
+ is_real_box_rat(A,RA)),
+ once (number(B),
+ rational(B,RB);
+ is_real_box_rat(B,RB)))
+ ->
+ (RA > RB ->
+ protected_unify(Bool,1)
+ ; protected_unify(Bool,0))
+ ; gt_real_reif_bis(Type,A,B,Bool)))).
gt_real_reif_bis(Type,A,B,Bool) :-
get_priority(Prio),
@@ -9390,7 +9359,7 @@ check_exists_gt_real_reif(Type,A,B,Bool,Continue) :-
(((Goal = gt_real_reif(Type,U,V,Bool1);
Goal = gt_real(Type,U,V),Bool1 = 1;
Goal = geq_real(Type,V,U),Bool1 = 0),
- member((Susp,Goal),LSusp),
+ member((_Susp,Goal),LSusp),
(A,B) == (U,V))
->
protected_unify(Bool,Bool1)
@@ -9517,8 +9486,6 @@ float_from_raw_uintN_rec(Type,Size,Int,Res) :-
check_not_NaN(Res),
set_lazy_domain(Type,Res),
!,
- mfd:get_intervals(Int,IInt),
- mreal:get_intervals(Res,IRes),
% Propagations du signe
max_posBV_float(Type,MaxPos),
max_negBV_float(Type,MaxNeg),
@@ -9537,7 +9504,7 @@ float_from_raw_uintN_rec(Type,Size,Int,Res) :-
(var(Sign) ->
true
; float_from_raw_uintN_rec1(Type,Size,Int,Res)).
-float_from_raw_uintN_rec(Type,Size,Int,Res).
+float_from_raw_uintN_rec(_Type,_Size,_Int,_Res).
float_from_raw_uintN_rec1(Type,Size,Int,Res) :-
mfd:get_intervals(Int,IInt),
@@ -9607,9 +9574,9 @@ get_raw_uint_from_float(SE,SM,BvS,1.0Inf,I) ?- !,
% Exposant a 1 et mantisse a 0
open(string(""),write,Stream),
write(Stream,BvS),
- (for(I,1,SE),param(Stream) do
+ (for(_I1,1,SE),param(Stream) do
write(Stream,1)),
- (for(I,1,SM),param(Stream) do
+ (for(_I2,1,SM),param(Stream) do
write(Stream,0)),
get_stream_info(Stream,name,Str),
close(Stream),
@@ -9624,18 +9591,23 @@ get_raw_uint_from_float(SE,SM,BvS,F,I) ?- !,
open(string(""),write,Stream),
write(Stream,BvS),
PSE is SE - 1,
- (for(I,PSE,0,-1),param(Stream,UNE) do
- getbit(UNE,I,B),
+ (for(I1,PSE,0,-1),param(Stream,UNE) do
+ getbit(UNE,I1,B),
write(Stream,B)),
PSM is SM - 1,
- (for(I,PSM,0,-1),param(Stream,M) do
- getbit(M,I,B),
+ (for(I2,PSM,0,-1),param(Stream,M) do
+ getbit(M,I2,B),
write(Stream,B)),
get_stream_info(Stream,name,Str),
close(Stream),
get_int_from_bv(bv("b",Str),I,_).
%% Les uninterp
+:- (current_array(ut,_) ->
+ true
+ ; local reference(ut)).
+
+%uninterp_trigger(F,_,_,F) :- !.
uninterp_trigger(F,Types0,Type0,Trigger) :-
(Types0 = [] ->
STypes = ""
@@ -9649,25 +9621,40 @@ uninterp_trigger(F,Types0,Type0,Trigger) :-
; FTerm =.. [F|Types],
term_string(FTerm,SFTerm),
concat_string([SFTerm,":",SType],STrigger)),
- atom_string(Trigger,STrigger).
+ getval(ut,Hash0),
+ (Hash0 == 0 ->
+ hash_create(Hash)
+ ; Hash = Hash0),
+ (hash_get(Hash,STrigger,Trigger) ->
+ true
+ ; atom_string(Trigger,STrigger),
+ hash_set(Hash,STrigger,Trigger),
+ setval(ut,Hash)).
uninterp(F,Trigger,TypeArgs,TypeR,Args,R) :-
get_priority(P),
set_priority(1),
- save_cstr_suspensions((Args,R)),
- get_saved_cstr_suspensions(LSusp0),
+/*
+ %save_cstr_suspensions((Args,R)),
+ %get_saved_cstr_suspensions(LSusp0),
% on a peut etre un uninterp clos contradictoire
attached_suspensions(Trigger,LSusp1),
append(LSusp0,LSusp1,LSusp),
(foreach(PairOrSusp,LSusp),
- param(F,Args,R,TypeArgs,TypeR) do
+ param(F,Trigger,Args,R,TypeArgs,TypeR) do
(PairOrSusp = (Susp,Goal) ->
true
; Susp = PairOrSusp,
(get_suspension_data(Susp,goal,Goal) ->
true
; Goal = dead)),
- (Goal = uninterp(F,Trigger,TypeArgs,TypeR,CArgs,CR) ->
+*/
+ attached_suspensions(Trigger,LSusp),
+ (foreach(Susp,LSusp),
+ param(F,Trigger,Args,R,TypeArgs,TypeR) do
+ ((get_suspension_data(Susp,goal,Goal),
+ Goal = uninterp(F,Trigger,TypeArgs,TypeR,CArgs,CR))
+ ->
(Args == CArgs ->
% factorisation
kill_suspension(Susp),
@@ -9680,12 +9667,13 @@ uninterp(F,Trigger,TypeArgs,TypeR,Args,R) :-
; not_unify(R,CR)),
only_one_neq_args_pair(TypeArgs,Args,CArgs,TA,A,CA))
->
- diff_reif(TA,Kill,A,CA,1)
+ diff_reif(TA,_Kill,A,CA,1)
; true))
; true)),
(ground(Args) ->
my_suspend(uninterp(F,Trigger,TypeArgs,TypeR,Args,R),0,trigger(Trigger))
- ; my_suspend(uninterp(F,Trigger,TypeArgs,TypeR,Args,R),0,(Args,R)->suspend:constrained)),
+ ; my_suspend(uninterp(F,Trigger,TypeArgs,TypeR,Args,R),0,[(Args,R)->suspend:constrained,trigger(Trigger)])),
+% ; my_suspend(uninterp(F,Trigger,TypeArgs,TypeR,Args,R),0,(Args,R)->suspend:inst)),
set_priority(P),
wake_if_other_scheduled(P).
@@ -9821,7 +9809,7 @@ undef_imod_real(Type,A,R) :-
launch_float_int_number(A),
launch_float_int_number(R),
uninterp_trigger(imod_real,[Type],Type,Trigger),
- uninterp(imod_real,Type,[Type],Type,[A],R).
+ uninterp(imod_real,Trigger,[Type],Type,[A],R).
chk_undef_float_to_real(Bool,TypeF,A,R) :-
set_lazy_domain(real,R),
@@ -10045,7 +10033,7 @@ check_ediv_mod_inst(AR,B,Q,BQ,AR,Stop) ?- !,
% A = R donc BQ = 0 donc Q = O (car B <> 0)
protected_unify(Q,0),
protected_unify(BQ,0),
- absA_lt_absB(A,B),
+ absA_lt_absB(AR,B),
Stop = 1.
check_ediv_mod_inst(0,B,Q,BQ,R,Stop) ?- !,
protected_unify(Q,0),
@@ -10074,7 +10062,7 @@ check_ediv_mod_inst(A,B,Q,0,R,Stop) ?- !,
% donc A pos
absA_lt_absB(A,B),
Stop = 1.
-check_ediv_mod_inst(A,B,Q,BQ,0,Stop) ?- !,
+check_ediv_mod_inst(A,_B,_Q,BQ,0,Stop) ?- !,
protected_unify(A,BQ),
Stop = 1.
check_ediv_mod_inst(A,B,Q,BQ,R,Stop) :-
@@ -10091,7 +10079,7 @@ check_ediv_mod_inst(A,B,Q,BQ,R,Stop) :-
protected_unify(R,R0).
check_ediv_mod_inst(A,B,Q,BQ,R,Stop) :-
get_saved_cstr_suspensions(LSusp),
- ((member((Susp,G),LSusp),
+ ((member((_Susp,G),LSusp),
(G = check_ediv_mod_bis(AA,BB,QQ,BBQQ,RR),
A == AA,
B == BB,
@@ -10114,7 +10102,7 @@ check_ediv_mod_inst(A,B,Q,BQ,R,Stop) :-
; true).
% B <> 0
-ediv(0,B,C) ?-
+ediv(0,_B,C) ?-
protected_unify(C,0).
ediv(A,B,C) :-
(A >= 0 ->
@@ -10130,7 +10118,7 @@ ediv(A,B,C) :-
%% Pas vraiment un undef pour B = 0 et bvudiv/bvurem
-%% Nouvelle semantique: Q tout a 1 et R a 0
+%% Nouvelle semantique: Q tout a 1 et R = A
chk_undef_div_rem(Bool,Type,A,B,Q,R,UO) :-
% // et rem pour int,intN et uintN
check_overflow(UO),
@@ -10145,10 +10133,7 @@ chk_undef_div_rem(Bool,Type,A,B,Q,R,UO) :-
set_int_type(Type,A),
set_int_type(Type,Q),
set_int_type(Type,R),
- (Type == int ->
- UO = 0
- ; mfd:set_intervals(UO,[-1..1])),
- undef_div_rem(Type,A,Q,R,UO)
+ undef_div_rem(Type,A,Q,R)
; protected_unify(Bool,0),
div_mod(Type,A,B,Q,R,UO))
; save_cstr_suspensions((A,B)),
@@ -10163,15 +10148,14 @@ chk_undef_div_rem(Bool,Type,A,B,Q,R,UO) :-
protected_unify(UO,UUO)
; my_suspend(chk_undef_div_rem(Bool,Type,A,B,Q,R,UO),0,
(Bool,A,B)->suspend:constrained))).
-undef_div_rem(int,A,Q,R,UO) :- !,
+undef_div_rem(int,A,Q,R) :- !,
uninterp_trigger(div_rem_int,[int],int,Trigger),
uninterp(div_rem_int,Trigger,[int],int,[A],(Q,R)).
-undef_div_rem(Type,A,Q,R,UO) :-
- % uint(N)
+undef_div_rem(Type,A,Q,R) :-
+ % uint(N), bvudiv/bvurem
% Q = 0
arg(1,Type,N),
All1 is 2^N-1,
- %protected_unify(UO,0),
protected_unify(Q,All1),
protected_unify(R,A).
@@ -10216,7 +10200,7 @@ undef_cdiv_crem(A,Q,R) :-
uninterp(cdiv_crem,Trigger,[real],real,[A],(Q,R)).
-cdiv_crem(0.0,B,Q,R) ?- !,
+cdiv_crem(0.0,_B,Q,R) ?- !,
protected_unify(Q,0.0),
protected_unify(R,0.0).
cdiv_crem(A,1.0,Q,R) ?- !,
@@ -10225,13 +10209,13 @@ cdiv_crem(A,1.0,Q,R) ?- !,
cdiv_crem(A,-1.0,Q,R) ?- !,
protected_unify(R,0.0),
op_real(real,A,Q).
-/*
+
% convergence lente sur cdiv_test_zero_sat.smt2
% car on manque des congruences ici
% A ajouter/adapter ?
cdiv_crem(A,B,Q,0.0) ?- !,
mult_real(real,B,Q,A).
-*/
+
cdiv_crem(A,A,Q,R) ?- !,
protected_unify(Q,1.0),
protected_unify(R,0.0).
@@ -10246,10 +10230,35 @@ cdiv_crem(A,B,Q,R) :-
get_priority(P),
set_priority(1),
save_cstr_suspensions((A,B,Q,R)),
+ % Congruences: pas de point fixe ici ?
+ ((exists_congr(A,_,_),
+ exists_congr(B,_,_))
+ ->
+ congr_div_directe(real,A,B,Q),
+ congr_mod_directe(real,A,B,R)
+ ; true),
+ ((exists_congr(B,CB,MB),
+ exists_congr(Q,CQ,MQ))
+ ->
+ congr_mult(CB,MB,CQ,MQ,CBQ,MBQ),
+ (exists_congr(A,CA,MA) ->
+ % R = A - BQ
+ inv_congr_add(CA,MA,CBQ,MBQ,CR,MR),
+ launch_congr(R,CR,MR)
+ ; true),
+ (exists_congr(R,NCR,NMR) ->
+ % A = BQ + R
+ congr_add(CBQ,MBQ,NCR,NMR,NCA,NMA),
+ launch_congr(A,NCA,NMA)
+ ; true)
+ ; true),
check_exists_cdiv_crem(A,B,Q,R,Continue),
(var(Continue) ->
true
- ; (Q == 0.0 ->
+ ; (not_unify(R,0.0) ->
+ mreal:dvar_remove_element(A,0.0)
+ ; true),
+ (Q == 0.0 ->
protected_unify(A,R)
; true),
(A == R ->
@@ -10272,7 +10281,7 @@ cdiv_crem(A,B,Q,R) :-
(NLA >= 0.0 ->
SA = pos
; (NHA =< 0.0 ->
- SA = neq
+ SA = neg
; true)),
(SB == pos ->
% A et Q de meme signe ou nuls
@@ -10312,9 +10321,9 @@ cdiv_crem(A,B,Q,R) :-
(var(Continue1) ->
true
; (((not_inf_bounds(A);
- is_real_box_rat(A,RA)),
+ is_real_box_rat(A,_RA)),
(not_inf_bounds(B);
- is_real_box_rat(B,RB)))
+ is_real_box_rat(B,_RB)))
->
% délégation aux entiers bornés
cast_real_int(real,A,IA),
@@ -10355,7 +10364,7 @@ cdiv_crem_inst_free(A,B,Q,R,Continue) :-
; % convergence lente sur cdiv_test_zero_sat.smt2
% car on manque des congruences ici
% A ajouter/adapter ?
- (fail,R == 0.0 ->
+ (R == 0.0 ->
call(spy_here)@eclipse,
mult_real(real,B,Q,A)
; (number(A) ->
@@ -10441,7 +10450,7 @@ check_exists_cdiv_crem(A,B,Q,R,Suspend) :-
(Var == V, NVar = OpAbsV;
Var == OpAbsV, NVar = V)),
get_cstr_suspensions(NVar,NLSusp),
- once (member_begin_end(Susp,NLSusp,NLSusp1,E2,E2),
+ once (member(Susp,NLSusp),
get_suspension_data(Susp,goal,cdiv_crem(X,Y,QQ,RR)),
(var(A) ->
% same_abs(A,X)
@@ -10508,17 +10517,17 @@ same_abs_real(A,X,LSusp,Rel,NLSusp) :-
; A == Y,
B == X)).
-chk_min_real(1,Type,A,B,R) ?- !,
+chk_min_real(1,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
-chk_min_real(NaN,Type,nan,B,R) ?- !,
+chk_min_real(_NaN,_Type,nan,B,R) ?- !,
protected_unify(B,R).
-chk_min_real(NaN,Type,A,nan,R) ?- !,
+chk_min_real(_NaN,_Type,A,nan,R) ?- !,
protected_unify(A,R).
-chk_min_real(NaN,Type,A,B,nan) ?- !,
+chk_min_real(NaN,_Type,A,B,nan) ?- !,
protected_unify(A,nan),
protected_unify(B,nan),
protected_unify(NaN,1).
-chk_min_real(NaN,Type,A,A,R) ?- !,
+chk_min_real(_NaN,_Type,A,A,R) ?- !,
% meme si A = nan
protected_unify(A,R).
chk_min_real(0,Type,A,B,R) ?- !,
@@ -10655,17 +10664,17 @@ check_exists_chk_min_real(NaN,Type,A,B,C) :-
; true)).
-chk_max_real(1,Type,A,B,R) ?- !,
+chk_max_real(1,_Type,_A,_B,R) ?- !,
protected_unify(R,nan).
-chk_max_real(NaN,Type,nan,B,R) ?- !,
+chk_max_real(_NaN,_Type,nan,B,R) ?- !,
protected_unify(B,R).
-chk_max_real(NaN,Type,A,nan,R) ?- !,
+chk_max_real(_NaN,_Type,A,nan,R) ?- !,
protected_unify(A,R).
-chk_max_real(NaN,Type,A,B,nan) ?- !,
+chk_max_real(NaN,_Type,A,B,nan) ?- !,
protected_unify(A,nan),
protected_unify(B,nan),
protected_unify(NaN,1).
-chk_max_real(NaN,Type,A,A,R) ?- !,
+chk_max_real(_NaN,_Type,A,A,R) ?- !,
% meme si A = nan
protected_unify(A,R).
chk_max_real(0,Type,A,B,R) ?- !,
@@ -10748,7 +10757,7 @@ check_exists_chk_max_real(NaN,Type,A,B,C) :-
CA == A)
->
% max(max(X,Y),B) = C
- ((member(chk_max_real(_,_,Z,T,MinYB),LG1),
+ ((member(chk_max_real(_,_,Z,T,MaxYB),LG1),
(T == B ->
Z == Y
; nonvar(Com),
@@ -10799,15 +10808,15 @@ check_exists_chk_max_real(NaN,Type,A,B,C) :-
; true)
; true)).
-fp_power(1,Type,A,N,R) ?- !,
+fp_power(1,_Type,_A,_N,R) ?- !,
protected_unify(R,nan).
fp_power(0,Type,A,N,R) ?- !,
ensure_not_NaN([A,R]),
power_real(Type,A,N,R).
-fp_power(NaN,Type,nan,_,R) ?- !,
+fp_power(NaN,_Type,nan,_,R) ?- !,
protected_unify(NaN,1),
protected_unify(R,nan).
-fp_power(NaN,Type,A,_,nan) ?- !,
+fp_power(NaN,_Type,A,_,nan) ?- !,
protected_unify(NaN,1),
protected_unify(A,nan).
fp_power(NaN,Type,A,N,R) :-
@@ -10827,17 +10836,17 @@ fp_power(NaN,Type,A,N,R) :-
(NaN,A,R)->suspend:constrained))).
-fp_ln(1,Type,A,R) ?- !,
+fp_ln(1,_Type,_A,R) ?- !,
protected_unify(R,nan).
fp_ln(0,Type,A,R) ?- !,
ensure_not_NaN([A,R]),
set_typed_intervals(A,Type,[-0.0 .. 1.0Inf]),
set_typed_intervals(R,Type,[-1.0Inf .. 1.0Inf]),
logn(Type,A,R).
-fp_ln(NaN,Type,nan,R) ?- !,
+fp_ln(NaN,_Type,nan,R) ?- !,
protected_unify(NaN,1),
protected_unify(R,nan).
-fp_ln(NaN,Type,A,nan) ?- !,
+fp_ln(NaN,_Type,_A,nan) ?- !,
% A est NaN ou < -0
protected_unify(NaN,1).
fp_ln(NaN,Type,A,R) :-
@@ -10855,18 +10864,18 @@ fp_ln(NaN,Type,A,R) :-
; my_suspend(fp_ln(NaN,Type,A,R),0,
(NaN,A,R)->suspend:constrained))).
-fp_exp(1,Type,A,R) ?- !,
+fp_exp(1,_Type,_A,R) ?- !,
protected_unify(R,nan).
fp_exp(0,Type,A,R) ?- !,
ensure_not_NaN([A,R]),
set_typed_intervals(A,Type,[-1.0Inf .. 1.0Inf]),
set_typed_intervals(R,Type,[0.0 .. 1.0Inf]),
exp(Type,A,R).
-fp_exp(NaN,Type,nan,R) ?- !,
+fp_exp(NaN,_Type,nan,R) ?- !,
protected_unify(NaN,1),
protected_unify(R,nan).
-fp_exp(NaN,Type,A,nan) ?- !,
- % A est NaN ou < -0
+fp_exp(NaN,_Type,A,nan) ?- !,
+ % A est NaN
protected_unify(NaN,1),
protected_unify(A,nan).
fp_exp(NaN,Type,A,R) :-
@@ -10885,7 +10894,7 @@ fp_exp(NaN,Type,A,R) :-
(NaN,A,R)->suspend:constrained))).
-fp_sqrt(1,Rnd,Type,A,R) ?- !,
+fp_sqrt(1,_Rnd,_Type,_A,R) ?- !,
protected_unify(R,nan).
fp_sqrt(0,Rnd,Type,A,R) ?- !,
ensure_not_NaN(A),
@@ -10893,10 +10902,10 @@ fp_sqrt(0,Rnd,Type,A,R) ?- !,
set_typed_intervals(A,Type,[-0.0 .. 1.0Inf]),
set_typed_intervals(R,Type,[-0.0 .. 1.0Inf]),
fp_sqrt_rnd(Rnd,Type,A,R).
-fp_sqrt(NaN,Rnd,Type,nan,R) ?- !,
+fp_sqrt(NaN,_Rnd,_Type,nan,R) ?- !,
protected_unify(NaN,1),
protected_unify(R,nan).
-fp_sqrt(NaN,Rnd,Type,A,nan) ?- !,
+fp_sqrt(NaN,_Rnd,_Type,_A,nan) ?- !,
% A nan ou < -0.0
protected_unify(NaN,1).
fp_sqrt(NaN,Rnd,Type,A,R) :-
@@ -10904,7 +10913,7 @@ fp_sqrt(NaN,Rnd,Type,A,R) :-
ensure_not_NaN(A),
protected_unify(NaN,0),
set_intervals(Type,A,[-0.0 .. 1.0Inf]),
- set_intervals(Type,B,[-0.0 .. 1.0Inf]),
+ set_intervals(Type,R,[-0.0 .. 1.0Inf]),
fp_sqrt(0,Rnd,Type,A,R)
; save_cstr_suspensions((A,R)),
get_saved_cstr_suspensions(LSusp),
@@ -11010,7 +11019,7 @@ get_range(V,Threshold,L,H) :-
getval(gdbg,1)@eclipse,
writeln(output,'Pb_get_range'(V,Threshold)),
fail),
- Tag,
+ _Tag,
(setval(threshold,OT)@eclipse,
setval(use_3B,U3B)@colibri,
getval(gdbg,1)@eclipse,
@@ -11043,7 +11052,7 @@ solve_cstrs :-
build_single_use_list(NDepConstraints,NSplitUseList),
once solve_cstrs_list([NSplitUseList]),
% Si on continue dans la ligne de requete
- init_dep_constraints(NPC)
+ init_dep_constraints(_NPC)
; true).
try_noNaN :-
@@ -11104,7 +11113,8 @@ solve_cstrs3(UseList,CVars,Seen,D) :-
solve_cstrs2(UseList,CVars,D) :-
call(smt_check_disabled_delta)@eclipse,
- %lin_solve(Status),
+% Problème à voir sur sat/bignum_lia2.smt2 avec mult_real ?
+ lin_solve(Status),
((Status == solved,
getval(gdbg,1)@eclipse)
->
@@ -11205,61 +11215,13 @@ connected_bool_vars(Var,Vars) :-
(foreach(V,CVars),
fromto([],In,Out,Vars),
param(Var) do
- ((get_type(V,int),
+ ((V \== Var,
+ get_type(V,int),
mfd:get_intervals(V,[0,1]))
->
Out = [V|In]
; Out = In)).
-/*
-get_most_constrained_bool_var(UseList,Var,Nb) :-
- term_variables(UseList,Vars),
- filter_bool_round_and_select_vars(Vars,BVars,SVars0),
- SVars = [],
- (BVars == [] ->
- BSVars = SVars
- ; BSVars = BVars),
- (BSVars = [(V,NbV)|EBSVars] ->
- (protected_get_var_name(V,_) ->
- true
- ; protected_set_var_name(V,"ColVar")),
- (foreach((VV,NbVV),EBSVars),
- fromto(V,IV,OV,Var),
- fromto(NbV,IN,ON,Nb) do
- (protected_get_var_name(VV,_) ->
- true
- ; protected_set_var_name(VV,"ColVar")),
- (NbVV > IN ->
- ON = NbVV,
- OV = VV
- ; ON = IN,
- OV = IV))
- ; Nb = 0).
-
-filter_bool_round_and_select_vars([],[],[]).
-filter_bool_round_and_select_vars([V|Vars],BVars,SVars) :-
- ((get_type(V,Type),
- (Type == int ->
- mfd:get_intervals(V,[0,1])
- ; Type == rnd),
- delayed_goals_number(V,Nb),
- Nb > 0)
- ->
- ((Type == int,
- is_select_var(V))
- ->
- BVars = EBVars,
- SVars = [(V,Nb)|ESVars]
- ; BVars = [(V,Nb)|EBVars],
- SVars = ESVars)
- ; BVars = EBVars,
- SVars = ESVars),
- filter_bool_round_and_select_vars(Vars,EBVars,ESVars).
-
-is_select_var(V) :-
- delayed_goals(V,DV),
- member(smtlib_select(_A,_I,_E,_,_),DV).
-*/
get_most_constrained_bool_var([],_,[],_,Var,Nb,Var,Nb).
get_most_constrained_bool_var([(V,D,Adj)|UseList],VN,NUseList,Seen,OVar,ONb,Var,Nb) :-
@@ -11288,8 +11250,7 @@ get_most_constrained_bool_var([(V,D,Adj)|UseList],VN,NUseList,Seen,OVar,ONb,Var,
EI = [L,H],
number(L),
number(H),
- mreal:dvar_size(E,2),
- call(spy_here)@eclipse)),
+ mreal:dvar_size(E,2))),
not occurs(E,ISeen))
->
(protected_get_var_name(E,_) ->
@@ -11422,15 +11383,18 @@ dep_cstr(Var,Vars,PC) :-
; Out = In)),
(ground((NVar,NVars)) ->
true
- ; my_suspend(dep_cstr(NVar,NVars,PC),2,(NVar,NVars,PC)->suspend:inst)).
+ ; % pas de steps ici ?
+ my_suspend(dep_cstr(NVar,NVars,PC),2,(NVar,NVars,PC)->suspend:inst)).
inst_cstr(Depth,Var,PC) :-
(nonvar(Var) ->
true
- ; my_suspend(inst_cstr(Depth,Var,PC),2,(Var,PC)->suspend:inst)).
+ ; % pas de steps ici ?
+ my_suspend(inst_cstr(Depth,Var,PC),2,(Var,PC)->suspend:inst)).
inst_cstr(Depth,Name,Var,PC) :-
(nonvar(Var) ->
true
- ; my_suspend(inst_cstr(Depth,Name,Var,PC),2,(Var,PC)->suspend:inst)).
+ ; % pas de steps ici ?
+ my_suspend(inst_cstr(Depth,Name,Var,PC),2,(Var,PC)->suspend:inst)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Heuritique de choix de la variable utilisee aussi dans "Noyau/fd_solve.pl"
@@ -11480,33 +11444,45 @@ choose_fd_var([Adj|UseList],Var,Size,NUseList) :-
% ou bien dans une adjacence ne contenant que des MaxCycleVars
delayed_goals(DG),
term_variables(DG,Vars0),
- filter_constrained_vars(Vars0,MinVars0),
- (foreach(V,MinVars0),
- fromto(MinVars,OV,IV,[]) do
- (is_real_box_rat(V,_) ->
- OV = IV
- ; OV = [V|IV])),
+ %filter_not_box_constrained_vars(Vars0,MinVars),
+ filter_constrained_vars(Vars0,MinVars),
MinVars \== [],
- leaf_vars([Adj|UseList],Leaves,NUseList),
+ leaf_vars([Adj|UseList],_Leaves,NUseList),
leaf_var_with_max_cstr_min_dom(MinVars,[],Var,Size).
%% leaf_var_with_max_cstr_min_dom(MinVars,Leaves,Var,Size).
leaf_vars(UseList,Leaves,NUseList) :-
- (foreach((V,D,A),UseList),
+ (foreach((V,_D,A),UseList),
fromto([],IT,OT,NUseList0) do
term_variables(A,NA0),
- (nonvar(V) ->
+ ((nonvar(V);
+ is_real_box_rat(V,_))
+ ->
(foreach(VA,NA0),
fromto(IT,INA,ONA,NewAdjs) do
- ONA = [(VA,0,[])|INA]),
+ ((nonvar(VA);
+ is_real_box_rat(VA,_))
+ ->
+ ONA = INA
+ ; ONA = [(VA,0,[])|INA])),
OT = NewAdjs
- ; ((member_begin_end(VV,NA0,NA,End,End),
+ ; % on enlève V de NA0
+ ((member_begin_end(VV,NA0,NA,End,End),
VV == V)
->
true
; NA = NA0),
- OT = [(V,0,NA)|IT])),
+ (foreach(VA,NA),
+ fromto(NewA,ONA,INA,[]),
+ param(V) do
+ ((nonvar(VA);
+ VA == V;
+ is_real_box_rat(VA,_))
+ ->
+ ONA = INA
+ ; ONA = [VA|INA])),
+ OT = [(V,0,NewA)|IT])),
sort(NUseList0,NUseList),
leaf_vars(NUseList,Leaves0),
sort(Leaves0,Leaves).
@@ -11537,10 +11513,10 @@ min_vars(UseList0,MinVars,NewUseList) :-
MaxC is 2^32),
% pas de redondance
sort(UseList0,UseList1),
- number_sort([2,1],Order0,UseList1,UseList),
delayed_goals(DG),
term_variables(DG,DGVars),
% trop cher On2 a cause des member_begin_end !!
+ % number_sort([2,1],Order0,UseList1,UseList),
% clean_uselist(UseList,UseList2),
UseList2 = UseList1,
min_vars_bis(UseList2,Order,MaxC,DGVars,Vars0,NewUseList,BagSufficient),
@@ -11580,7 +11556,7 @@ clean_uselist([(V,C,Adj)|UseList],NUseList) :-
NUseList = [(V,NC,NAdj)|ENUseList],
clean_uselist(UseList1,ENUseList).
-clean_uselist_var(V,C,Adj,[],C,Adj,[]).
+clean_uselist_var(_V,C,Adj,[],C,Adj,[]).
clean_uselist_var(V,C,Adj,UseList,NC,NAdj,NUseList) :-
((occurs(V,UseList),
member_begin_end((VV,CC,AAdj),UseList,NUseList,PEnd,EndUseList),
@@ -11594,9 +11570,20 @@ clean_uselist_var(V,C,Adj,UseList,NC,NAdj,NUseList) :-
NUseList = UseList).
+filter_not_box_constrained_vars([],[]).
+filter_not_box_constrained_vars([V|L],NL) :-
+ ((no_constraint(V);
+ is_real_box(V))
+ ->
+ NL = ENL
+ ; NL = [V|ENL]),
+ filter_not_box_constrained_vars(L,ENL).
+
filter_constrained_vars([],[]).
filter_constrained_vars([V|L],NL) :-
- (no_constraint(V) ->
+ ((no_constraint(V);
+ is_real_box_rat(V,_))
+ ->
NL = ENL
; NL = [V|ENL]),
filter_constrained_vars(L,ENL).
@@ -11849,7 +11836,7 @@ leaf_var_with_max_cstr_min_dom(L,Leaves,Var,MinSize) :-
var_with_max_cstr_min_dom(NL,Var,MinSize)
; NL = [NV|ENL],
get_type(NV,Type),
- dvar_size(Type,NV,Size0),
+ dvar_size_check_real(Type,NV,Size0),
(ENL == [] ->
Var = NV,
MinSize = Size0
@@ -11870,7 +11857,7 @@ leaf_var_with_max_cstr_min_dom0([V|LV],Leaves,Var0,NbV0,Size0,Leaf0,Var,MinSize)
constraints_number(V,NbV),
NbV >= NbV0,
get_type(V,Type),
- dvar_size(Type,V,Size),
+ dvar_size_check_real(Type,V,Size),
(NbV > NbV0 ->
true
; Size < Size0))
@@ -11903,6 +11890,12 @@ leaf_var_with_max_cstr_min_dom0([V|LV],Leaves,Var0,NbV0,Size0,Leaf0,Var,MinSize)
MinSize = Size1
; leaf_var_with_max_cstr_min_dom0(LV,Leaves,Var1,NbV1,Size1,Leaf1,Var,MinSize)).
+dvar_size_check_real(real,V,Size) :- !,
+ (not_inf_bounds(V) ->
+ dvar_size(real,V,Size)
+ ; Size = 1.0Inf).
+dvar_size_check_real(Type,V,Size) :-
+ dvar_size(Type,V,Size).
var_with_max_cstr_min_dom([V|LV],Var,MinSize) :-
((get_type(V,Type),
@@ -11910,43 +11903,55 @@ var_with_max_cstr_min_dom([V|LV],Var,MinSize) :-
->
(LV == [] ->
Var = V,
- dvar_size(Type,V,MinSize)
- ; dvar_size(Type,V,Size),
+ dvar_size_check_real(Type,V,MinSize)
+ ; dvar_size_check_real(Type,V,Size),
constraints_number(V,NbV),
var_with_max_cstr_min_dom1(LV,V,Size,NbV,Var,MinSize))
; var_with_max_cstr_min_dom(LV,Var,MinSize)).
-var_with_max_cstr_min_dom1([],V,Size,NbV,V,Size).
+var_with_max_cstr_min_dom1([],V,Size,_NbV,V,Size).
var_with_max_cstr_min_dom1([VV|LV],IV,IS,INb,Var,MinSize) :-
((get_type(VV,Type),
Type \= array(_,_))
->
- dvar_size(Type,VV,Size),
- ((IS == 2,
- Size > 2)
+ ((is_real_box(IV),
+ not is_real_box(VV))
->
- % priorite aux booleens
- OS = IS,
- ONb = INb,
- OV = IV
- ; constraints_number(VV,NbVar),
- ((IS > 2,
- Size == 2;
- NbVar > INb)
+ OV = VV,
+ dvar_size_check_real(Type,VV,OS),
+ constraints_number(VV,ONb)
+ ; ((is_real_box(VV),
+ not is_real_box(IV))
->
- % priorite aux booleens
- ONb = NbVar,
- OS = Size,
- OV = VV
- ; ((NbVar == INb,
- Size < IS)
+ OV = IV,
+ OS = IS,
+ ONb = INb
+ ; dvar_size_check_real(Type,VV,Size),
+ ((IS == 2,
+ Size > 2)
->
- OV = VV,
- ONb = NbVar,
- OS = Size
- ; OV = IV,
+ % priorite aux booleens
+ OS = IS,
ONb = INb,
- OS = IS)))
+ OV = IV
+ ; constraints_number(VV,NbVar),
+ ((IS > 2,
+ Size == 2;
+ NbVar > INb)
+ ->
+ % priorite aux booleens
+ ONb = NbVar,
+ OS = Size,
+ OV = VV
+ ; ((NbVar == INb,
+ Size < IS)
+ ->
+ OV = VV,
+ ONb = NbVar,
+ OS = Size
+ ; OV = IV,
+ ONb = INb,
+ OS = IS)))))
; % variable d'un ite/ une sorte
OV = IV,
ONb = INb,
@@ -12028,25 +12033,9 @@ simple_solve_var_float(Type,Var) :-
call_priority(
(Var = -0.0;
Var = 0.0;
- (fail,is_mult_div_real_arg(Type,Var) ->
- % mauvais pour spark/asso_mult (sat)
- (Var = 1.0;
- Var = -1.0;
- forbid_zero(Type,Var),
- mreal:dvar_remove_element(Var,1.0),
- mreal:dvar_remove_element(Var,-1.0),
- simple_resol_float(Var))
- ; forbid_zero(Type,Var),
- simple_resol_float(Var))),
+ forbid_zero(Type,Var),
+ simple_resol_float(Var)),
1).
-/*
- ;
- protected_get_var_name(Var,VN),
- getval(last_var_fail,LVN)@eclipse,
- append(LVN,[VN],NLVN),
- setval(last_var_fail,NLVN)@eclipse,
- fail.
-*/
is_mult_div_real_arg(Type,Var) :-
suspensions(Var,LSusp),
@@ -12267,12 +12256,12 @@ simple_resol_float(Var) :-
my_notify_constrained(Var)
; true).
-get_next_zfloat(Type,-0.0,Next) ?- !,
+get_next_zfloat(_Type,-0.0,Next) ?- !,
Next = 0.0.
get_next_zfloat(Type,V,N) :-
get_next_float(Type,V,N).
-get_previous_zfloat(Type,0.0,Prev) ?- !,
+get_previous_zfloat(_Type,0.0,Prev) ?- !,
Prev = -0.0.
get_previous_zfloat(Type,V,P) :-
get_previous_float(Type,V,P).
@@ -12296,27 +12285,31 @@ simple_resol_real(Var) :-
% avant de piocher au hasard
(Var = Min0 ;
get_next_float(real,Min0,Min1),
- mreal:set_typed_intervals(Var,real,[Min1..Max0]),
- (Var = Max0 ;
- get_previous_float(real,Max0,Max1),
- mreal:set_typed_intervals(Var,real,[Min0..Max1]),
- mreal:dvar_range(Var,Min,Max),
- (is_float_int_number(Var) ->
- % On reutilise le choix de la version entiere
- get_small_random_value_in_real_interval_float_int(real,Min..Max,Value)
- ; mreal:dvar_size(Var,Size),
- get_small_random_value_in_real_interval(real,Min..Max,Size,Value)),
- get_next_float(real,Value,NV),
- get_previous_float(real,Value,PV),
- random_less(2,Rand),
- % On essaye Value, puis au dessus/dessous de Value
- ( Var = Value
- ; (Rand == 0 ->
- set_typed_intervals(Var,real,[NV..1.0Inf])
- ; set_typed_intervals(Var,real,[-1.0Inf..PV]))
- ; (Rand == 0 ->
- set_typed_intervals(Var,real,[-1.0Inf..PV])
- ; set_typed_intervals(Var,real,[NV..1.0Inf])))))
+ (Min1 == 1.0Inf ->
+ launch_box(Var)
+ ; mreal:set_typed_intervals(Var,real,[Min1..Max0]),
+ (Var = Max0 ;
+ get_previous_float(real,Max0,Max1),
+ (Max1 == -1.0Inf ->
+ launch_box(Var)
+ ; mreal:set_typed_intervals(Var,real,[Min0..Max1]),
+ mreal:dvar_range(Var,Min,Max),
+ (is_float_int_number(Var) ->
+ % On reutilise le choix de la version entiere
+ get_small_random_value_in_real_interval_float_int(real,Min..Max,Value)
+ ; mreal:dvar_size(Var,Size),
+ get_small_random_value_in_real_interval(real,Min..Max,Size,Value)),
+ get_next_float(real,Value,NV),
+ get_previous_float(real,Value,PV),
+ random_less(2,Rand),
+ % On essaye Value, puis au dessus/dessous de Value
+ ( Var = Value
+ ; (Rand == 0 ->
+ set_typed_intervals(Var,real,[NV..1.0Inf])
+ ; set_typed_intervals(Var,real,[-1.0Inf..PV]))
+ ; (Rand == 0 ->
+ set_typed_intervals(Var,real,[-1.0Inf..PV])
+ ; set_typed_intervals(Var,real,[NV..1.0Inf])))))))
; mreal:dvar_range(Var,Min,Max),
mreal:dvar_size(Var,Size),
(not (Size == 2,
@@ -12618,8 +12611,9 @@ smt_check_disabled_delta :-
getval(simplex_steps,Steps2)@eclipse,
Steps is Steps1 + Steps2, %?
Diff is T1-T0,
- ((2*Steps2 > Steps1;
- Steps >= DDSteps)
+ ((Steps1 > 0,
+ (2*Steps2 > Steps1;
+ Steps >= DDSteps))
->
(getval(show_steps,1)@eclipse ->
writeln(output,"Delay/Steps disabled delta":Diff/Steps1/Steps2)
diff --git a/Src/COLIBRI/solve_util.pl b/Src/COLIBRI/solve_util.pl
index e470a4ebe997ad1bd8f664941ec7c7ec54563aa8..4d1716db43a36921f06229c14b47285f4ce9b786 100755
--- a/Src/COLIBRI/solve_util.pl
+++ b/Src/COLIBRI/solve_util.pl
@@ -529,7 +529,7 @@ get_small_random_value_in_real_interval(Inter,Size,Res) :-
get_small_random_value_in_real_interval(Type,Inter,Size,Res).
%%:- mode get_small_random_value_in_real_interval(++,++,++,?).
-get_small_random_value_in_real_interval(Type,Low..High,Size,Res) :-
+get_small_random_value_in_real_interval(Type,Low..High,_Size,Res) :-
Low =< 0.0,
High >= 0.0,
!,
@@ -538,7 +538,7 @@ get_small_random_value_in_real_interval(Type,Low..High,Size,Res) :-
; (High == -0.0 ->
Res = High
; Res = 0.0)).
-get_small_random_value_in_real_interval(Type,Low..High,Size,Res) :- !,
+get_small_random_value_in_real_interval(Type,Low..High,_Size,Res) :- !,
% ON ESSAYE LA PLUS FAIBLE PRECISION
get_integer_interval_and_accurracy(Type,Low,High,ILow,IHigh,Exp),
(ILow =< IHigh ->
@@ -645,69 +645,69 @@ get_integer_interval_and_accurracy_bis(L,H,IL,IH,Exp) :-
%% ANCIENNE VERSION AVEC CHOIX CENTRAL
%:- mode get_mid_random_value_in_real_interval(++,++,?).
get_mid_random_value_in_real_interval(Inter,Size,Value) :-
- getval(float_eval,Type)@eclipse,
- get_mid_random_value_in_real_interval(Type,Inter,Size,Value).
+ getval(float_eval,Type)@eclipse,
+ get_mid_random_value_in_real_interval(Type,Inter,Size,Value).
get_mid_random_value_in_real_interval(Type,Inter,Size,Value) :-
- min_max_inter(Inter,Low,High),
- Diff is High - Low,
- (Diff > 1.0 ->
- Try_integer = 1,
- FHigh is integer(floor(High)),
- FLow is integer(ceiling(Low)),
- (FHigh =< High ->
- (FHigh >= Low ->
- IHigh = FHigh
- ; IHigh is FHigh + 1)
- ; IHigh is FHigh - 1),
- (FLow =< High ->
- (FLow >= Low ->
- ILow = FLow
- ; ILow is FLow + 1)
- ; ILow is FLow - 1)
- ; (is_integer(Low,ILow) ->
- Try_integer = 1,
- IHigh = ILow
- ; (is_integer(High,IHigh) ->
- Try_integer = 1,
- ILow = IHigh
- ;true))),
- (nonvar(Try_integer) ->
- %% On privilegie les valeurs entieres quand les
- %% bornes sont entieres (a cause des cast_int_real !)
- get_mantissa_size(Type,MSize),
- DeuxPuissMS is 2^(MSize+1),
- ((ILow < DeuxPuissMS,
- IHigh > DeuxPuissMS)
- ->
- %% On evite de passer au dessus de 2^53 pour
- %% ne pas tomber dans les "entiers" non representables
- %% (encore a cause des cast)
- NIHigh = DeuxPuissMS,
- MoinsDeuxPuiss53 is - DeuxPuissMS,
- (ILow < MoinsDeuxPuissMS ->
- NILow = MoinsDeuxPuissMS
- ; NILow = ILow)
- ; NILow = ILow,
- NIHigh = IHigh),
- ISize is 1 + (NIHigh - NILow),
- get_mid_random_value_in_interval(NILow..NIHigh,ISize,1,0,IValue),
- int_to_float(Type,IValue,Value)
- ; %% Pas d'entier dans l'intervalle
-%% A REVOIR !!!!
- Fract = 3,
- (Size > Fract ->
- Q is Diff / Fract,
- frandom(R),
- MidRand is Q + R*Q,
- Value1 is Low + MidRand
- ; random_less(Size,Rank),
- get_nth_float_from(Type,Low,Rank,Value1)),
- try_to_keep_precision(Value1,Inter,Value0),
- (Type == float_simple ->
- cast_double_to_simple_float(Value0,Value)
- ; %% real ou float_double
- Value = Value0)).
+ min_max_inter(Inter,Low,High),
+ Diff is High - Low,
+ (Diff > 1.0 ->
+ Try_integer = 1,
+ FHigh is integer(floor(High)),
+ FLow is integer(ceiling(Low)),
+ (FHigh =< High ->
+ (FHigh >= Low ->
+ IHigh = FHigh
+ ; IHigh is FHigh + 1)
+ ; IHigh is FHigh - 1),
+ (FLow =< High ->
+ (FLow >= Low ->
+ ILow = FLow
+ ; ILow is FLow + 1)
+ ; ILow is FLow - 1)
+ ; (is_integer(Low,ILow) ->
+ Try_integer = 1,
+ IHigh = ILow
+ ; (is_integer(High,IHigh) ->
+ Try_integer = 1,
+ ILow = IHigh
+ ; true))),
+ (nonvar(Try_integer) ->
+ % On privilegie les valeurs entieres quand les
+ % bornes sont entieres (a cause des cast_int_real !)
+ get_mantissa_size(Type,MSize),
+ DeuxPuissMS is 2^(MSize+1),
+ ((ILow < DeuxPuissMS,
+ IHigh > DeuxPuissMS)
+ ->
+ % On evite de passer au dessus de 2^53 pour
+ % ne pas tomber dans les "entiers" non representables
+ % (encore a cause des cast)
+ NIHigh = DeuxPuissMS,
+ MoinsDeuxPuissMS is - DeuxPuissMS,
+ (ILow < MoinsDeuxPuissMS ->
+ NILow = MoinsDeuxPuissMS
+ ; NILow = ILow)
+ ; NILow = ILow,
+ NIHigh = IHigh),
+ ISize is 1 + (NIHigh - NILow),
+ get_mid_random_value_in_interval(NILow..NIHigh,ISize,1,0,IValue),
+ int_to_float(Type,IValue,Value)
+ ; % Pas d'entier dans l'intervalle
+ %% A REVOIR !!!!
+ Fract = 3,
+ (Size > Fract ->
+ Q is Diff / Fract,
+ frandom(R),
+ MidRand is Q + R*Q,
+ Value1 is Low + MidRand
+ ; random_less(Size,Rank),
+ get_nth_float_from(Type,Low,Rank,Value1)),
+ try_to_keep_precision(Value1,Inter,Value0),
+ (Type == float_simple ->
+ cast_double_to_simple_float(Value0,Value)
+ ; % real ou float_double
+ Value = Value0)).
integral_bounds(Low,High,ILow,IHigh) :-
@@ -726,21 +726,21 @@ not_inf_val(R) :-
R \== 1.0Inf,
R \== -1.0Inf.
-try_to_keep_precision(Val,Inter,Res) :-
+try_to_keep_precision(_Val,Inter,Res) :-
number(Inter),!,
Res = Inter.
try_to_keep_precision(Val,Inter,Res) :-
- round_to_nearest_precision(Val,Inter,Res).
+ round_to_nearest_precision(Val,Inter,Res).
round_to_nearest_precision(Val,Min..Max,Res) :- !,
getval(precision,Prec)@eclipse,
DixPuisPrec is 10^(Prec),
round_to_smallest_precision(Val,Min,Max,DixPuisPrec,Res).
- round_to_nearest_precision(Val,Res,Res).
+ round_to_nearest_precision(_Val,Res,Res).
round_to_smallest_precision(Val,Min..Max,Res) :- !,
round_to_smallest_precision(Val,Min,Max,1,Res).
- round_to_smallest_precision(Val,Res,Res).
+ round_to_smallest_precision(_Val,Res,Res).
round_to_smallest_precision(Val,Min,Max,DixPuisPrec,Res) :-
PVal is Val * DixPuisPrec,
@@ -778,7 +778,7 @@ narrow_leaves(_).
narrow_vars(L) :-
getval(use_3B,1),!,
force_narrow_vars(L).
-narrow_vars(L).
+narrow_vars(_).
force_narrow_vars(L) :-
try_vars_sub_intervals(L,NL),
@@ -822,7 +822,7 @@ try_sub_intervals(Var,Type,mreal,LInter) :-
try_real_sub_intervals(Var,Type,LInter,NLInter),
mreal:set_typed_intervals(Var,Type,NLInter).
-try_int_sub_intervals(Var,[],[]).
+try_int_sub_intervals(_Var,[],[]).
try_int_sub_intervals(Var,[I|LI],NLI) :-
((not (
mfd:set_intervals(Var,[I]),
@@ -887,7 +887,7 @@ narrow_vars_bounds0(L,R,KeepL) :-
(nonvar(Work) ->
% on recommence
narrow_vars_bounds1(WorkL,R)
- ; NewL = NL).
+ ; true).
narrow_vars_bounds1(L,R) :-
narrow_chk_vars_bounds(L,R,_,WorkL,Work),
@@ -971,12 +971,12 @@ narrow_right0(Var,Type,Mod,R,Low,High,Work) :-
; true).
-get_next(int,Mod,Val,Next) :- !,
+get_next(int,_Mod,Val,Next) :- !,
Next is Val + 1.
get_next(Type,mreal,Val,Next) :-
get_next_float(Type,Val,Next).
-get_previous(int,Mod,Val,Prev) :- !,
+get_previous(int,_Mod,Val,Prev) :- !,
Prev is Val - 1.
get_previous(Type,mreal,Val,Prev) :-
get_previous_float(Type,Val,Prev).
diff --git a/Src/COLIBRI/util.pl b/Src/COLIBRI/util.pl
index 042e6885c5622ecad90a221c58a55632f1e4a2ac..133241fdbe6ec44e769fa16ab6ca32697fd28c2d 100755
--- a/Src/COLIBRI/util.pl
+++ b/Src/COLIBRI/util.pl
@@ -7,16 +7,16 @@
:- export myspy/1.
:- export op(1000,fy,myspy).
myspy(Pred/N) ?- !,
- ground(Pred),
- ( current_module(M),
- get_module_info(M,locked,off),
- current_predicate(Pred/N)@M,
- force_spy(Pred,N,M),
- fail
- ; true).
+ ground(Pred),
+ ( current_module(M),
+ get_module_info(M,locked,off),
+ current_predicate(Pred/N)@M,
+ force_spy(Pred,N,M),
+ fail
+ ; true).
myspy(Pred) :-
- ground(Pred),
- myspy(Pred/N).
+ ground(Pred),
+ myspy(Pred/_N).
force_spy(Pred,Arity,Module) :-
@@ -101,7 +101,7 @@ member_begin_end(E,[E1|L],Begin,EndBeg,End) :-
:- export get_last_cond/3.
get_last_cond((A,B),Pref,Last) ?- !,
((nonvar(B),
- B = (C,D))
+ B = (_,_))
->
Pref = (A,EPref),
get_last_cond(B,EPref,Last)
@@ -257,6 +257,19 @@ protected_occurs_in_list(X,L) :-
XX == X
; occurs(X,L)).
+:- export protected_numerator/2.
+protected_numerator(Rat,R) :-
+ block(R is numerator(Rat),
+ _Tag,
+ (call(spy_here)@eclipse,
+ R is numerator(Rat))).
+:- export protected_denominator/2.
+protected_denominator(Rat,R) :-
+ block(R is denominator(Rat),
+ _Tag,
+ (call(spy_here)@eclipse,
+ R is denominator(Rat))).
+
%%:- mode unify_vars(+).
unify_vars([A|L]) :-
unify_vars(A,L).
@@ -370,24 +383,24 @@ sum_intervals_size_congr([I|LI],S,Mod,NS) :-
%% A priori les bornes sont compatibles
%%:- mode interval_size_congr(++,++,++,-).
-interval_size_congr(I,S,Mod,NS) :-
- atomic(I),!,
- NS is S + 1.
+interval_size_congr(I,S,_Mod,NS) :-
+ atomic(I),!,
+ NS is S + 1.
interval_size_congr(L..H,S,Mod,NS) :-
- SI is 1 + (H div Mod) - (L div Mod),
- NS is S + SI.
+ SI is 1 + (H div Mod) - (L div Mod),
+ NS is S + SI.
%% Donne le rang de E dans la liste
%% ou bien l'element E au rang Rank
%% (en construisant la liste si elle est une variable)
nth_elem([I|L],E,Rank) :-
- nth_elem([I|L],E,1,Rank).
+ nth_elem([I|L],E,1,Rank).
%% Utilise dans simulation.tcl en initialisant le rang a 0
-nth_elem([I|L],I,Rank,Rank).
+nth_elem([I|_L],I,Rank,Rank).
nth_elem([_|L],I,ORank,Rank) :-
- NRank is ORank + 1,
- nth_elem(L,I,NRank,Rank).
+ NRank is ORank + 1,
+ nth_elem(L,I,NRank,Rank).
%% Utilitaires de gestion du signe
@@ -416,7 +429,7 @@ get_interval_sign(Inter,Sign) :-
is_pos_number(int,Val) ?- !,
Val >= 0.
-is_pos_number(Type,Val) :-
+is_pos_number(_Type,Val) :-
once (Val == 0.0;
Val > 0.0).
@@ -450,7 +463,7 @@ op_sign(pos,neg).
%% Pour fusionner les variables des memes contraintes
%% arithmetiques ternaires entieres ou reelles et tuer les suspensions concernees
%%:- mode clear_Goals(++,+).
-clear_Goals(Ops,[(Name,Val1,Val2,Val)|LNameArgs]) :-
+clear_Goals(_Ops,[(Name,Val1,Val2,Val)|LNameArgs]) :-
get_saved_cstr_suspensions(LSuspGoal),
clear_Goals_LSuspGoal([(Name,Val1,Val2,Val)|LNameArgs],LSuspGoal).
clear_Goal(Name,Val1,Val2,Val) :-
@@ -481,23 +494,23 @@ unify_pairs([V1,V2|L]) :-
collect_UVars_in_matching_Goal_suspensions([],_,_,_,_,[],[]).
collect_UVars_in_matching_Goal_suspensions([(Susp,Goal)|LSusp],Name,Val1,Val2,Val,UVars,NLSusp) :-
- ((make_matching_goal(Name,Goal,V1,V2,V3,Kind),
- (match_bin_op(Kind,Val1,Val2,Val,V1,V2,V3,U1,U2);
- match_add_with_op_number(Name,Val1,Val2,Val,V1,V2,V3,U1,U2);
- %% On essaye le match de minus(Val1,Val2,Val3)
- match_minus(Name,Val1,Val2,Val,V1,V2,V3,U1,U2);
- match_op_from_add(Name,Val1,Val2,Val,V1,V2,V3,U1,U2,MatchOp)))
- ->
- kill_suspension(Susp),
- (var(MatchOp) ->
- UVars = [U1,U2|UVars1]
- ; UVars = UVars1,
- %% On lancera un op_int/real apres
- get_priority(P),
- NP is min(12,P+1),
- (Name == add_int ->
- call_priority(op_int(U1,U2),NP)
- ; % donc add_real
+ ((make_matching_goal(Name,Goal,V1,V2,V3,Kind),
+ (match_bin_op(Kind,Val1,Val2,Val,V1,V2,V3,U1,U2);
+ match_add_with_op_number(Name,Val1,Val2,Val,V1,V2,V3,U1,U2);
+ % On essaye le match de minus(Val1,Val2,Val3)
+ match_minus(Name,Val1,Val2,Val,V1,V2,V3,U1,U2);
+ match_op_from_add(Name,Val1,Val2,Val,V1,V2,V3,U1,U2,MatchOp)))
+ ->
+ kill_suspension(Susp),
+ (var(MatchOp) ->
+ UVars = [U1,U2|UVars1]
+ ; UVars = UVars1,
+ % On lancera un op_int/real apres
+ get_priority(P),
+ NP is min(12,P+1),
+ (Name == add_int ->
+ call_priority(op_int(U1,U2),NP)
+ ; % donc add_real
((var(U1),
get_type(U1,Type);
var(U2),
@@ -505,10 +518,10 @@ collect_UVars_in_matching_Goal_suspensions([(Susp,Goal)|LSusp],Name,Val1,Val2,Va
->
call_priority(op_real(Type,U1,U2),NP)
; call_priority(op_real(U1,U2),NP)))),
- NLSusp = LSusp1
- ; UVars = UVars1,
- NLSusp = [(Susp,Goal)|LSusp1]),
- collect_UVars_in_matching_Goal_suspensions(LSusp,Name,Val1,Val2,Val,UVars1,LSusp1).
+ NLSusp = LSusp1
+ ; UVars = UVars1,
+ NLSusp = [(Susp,Goal)|LSusp1]),
+ collect_UVars_in_matching_Goal_suspensions(LSusp,Name,Val1,Val2,Val,UVars1,LSusp1).
%%:- mode make_matching_goal(++,?,?,?,?,?).
@@ -679,29 +692,32 @@ match_bin_op(all,A,B,C,V1,V2,V3,U1,U2) :-
%% Commutatif et inversible quand l'argument (1 ou 2)
%% commun est non nul
match_bin_op(all_not_null(Type),A,B,C,V1,V2,V3,U1,U2) :-
- (A == V1 ->
- (B == V2 ->
- %% A op B = C et A op B = D -> C = D
- U1 = C, U2 = V3
- ; not_null(Type,A),
- C == V3,
- %% A op B = C et A op D = C -> B = D
- U1 = B, U2 = V2)
- ; (A == V2 ->
- (B == V1 ->
- %% A op B = C et B op A = D -> C = D
- U1 = C, U2 = V3
- ; not_null(Type,A),
- C == V3,
- %% A op B = C et D op A = C -> B = D
- U1 = B, U2 = V1)
- ; C == V3,
- not_null(Type,B),
- U1 = A,
- (B == V2 ->
- U2 = V1
- ; B == V1,
- U2 = V2))).
+ (A == V1 ->
+ (B == V2 ->
+ % A op B = C et A op B = D -> C = D
+ U1 = C, U2 = V3
+ ; not_null(Type,A),
+ C == V3,
+ not_null(Type,C),
+ % A op B = C et A op D = C -> B = D
+ U1 = B, U2 = V2)
+ ; (A == V2 ->
+ (B == V1 ->
+ % A op B = C et B op A = D -> C = D
+ U1 = C, U2 = V3
+ ; not_null(Type,A),
+ C == V3,
+ not_null(Type,C),
+ % A op B = C et D op A = C -> B = D
+ U1 = B, U2 = V1)
+ ; C == V3,
+ not_null(Type,C),
+ not_null(Type,B),
+ U1 = A,
+ (B == V2 ->
+ U2 = V1
+ ; B == V1,
+ U2 = V2))).
%% Commutatif et pas inversible
match_bin_op(com_noinv,A,B,C,V1,V2,V3,U1,U2) :-
(A == V1 ->
@@ -743,7 +759,7 @@ match_bin_op(nocom_noinv,A,B,C,V1,V2,V3,U1,U2) :-
*/
reduce_Res_from_matching_Goals(Name,Type,Val1,Val2,Res) :-
get_saved_cstr_suspensions(LSuspGoal),
- (foreach((S,Goal),LSuspGoal),
+ (foreach((_S,Goal),LSuspGoal),
param(Name,Type,Val1,Val2,Res) do
reduce_Res_from_Goal(Name,Type,Goal,Val1,Val2,Res)).
@@ -777,7 +793,7 @@ reduce_Res_from_Goal(minus_real1,Type,minus_real1(Type,V1,V2,CRes),Val1,Val2,Res
; NRel = Rel),
check_real_ineq_from_Rel_between_args(NRel,Type,Res,CRes)
; true).
-reduce_Res_from_Goal(Name,Type,Goal,Val1,Val2,Val).
+reduce_Res_from_Goal(_Name,_Type,_Goal,_Val1,_Val2,_Val).
sym_rel('>','<') :- !.
sym_rel('>=','=<') :- !.
@@ -800,7 +816,7 @@ check_real_ineq_from_Rel_between_args('<',Type,Res,CRes) :- !,
check_geq_real(Type,CRes,Res,_,1)).
check_real_ineq_from_Rel_between_args('=<',Type,Res,CRes) :- !,
check_geq_real(Type,CRes,Res,_,1).
-check_real_ineq_from_Rel_between_args('=',Type,Res,CRes) :- !,
+check_real_ineq_from_Rel_between_args('=',_Type,Res,CRes) :- !,
protected_unify(Res = CRes).
check_real_ineq_from_Rel_between_args('#',real,Res,CRes) :- !,
% pas toujours vrai en float
@@ -907,7 +923,7 @@ list_to_intervals(Type,List,Intervals) :-
sort(Pairs,SortedPairs),
merge_pairs(Type,SortedPairs,Intervals).
-intervals_to_pairs(Type,[],[]).
+intervals_to_pairs(_Type,[],[]).
intervals_to_pairs(Type,[I|LI],[P|LP]) :-
interval_to_pair(Type,I,P),
intervals_to_pairs(Type,LI,LP).
@@ -934,7 +950,8 @@ number_from_type(float_double,V,NV) :- !,
NV is float(V).
number_from_type(float_simple,V,NV) :- !,
NV is float(V).
-number_from_type(Type,V,NV) :-
+number_from_type(Type,_V,_NV) :-
+ call(spy_here)@eclipse,
writeln(output,erreur_number_from_type(Type)),
exit_block(abort).
@@ -954,7 +971,7 @@ merge_pairs(float_double,LP,L,H,MLP) :- !,
merge_float_pairs(float_double,LP,L,H,MLP).
merge_pairs(real,LP,L,H,MLP) :- !,
merge_real_pairs(LP,L,H,MLP).
-merge_pairs(Type,LP,L,H,MLP) :-
+merge_pairs(Type,_LP,_L,_H,_MLP) :-
writeln(output,erreur_merge_pairs(Type)),
exit_block(abort).
%% Version "entiere" pour mfd
@@ -1046,7 +1063,7 @@ merge_real_pairs([L..H|LP],Low,High,MLP) :-
L = [Low..High|NL].
interval_from_pair1(float_double,Low,High,L,NL) :- !,
L = [Low..High|NL].
- interval_from_pair1(Type,Low,High,L,NL) :-
+ interval_from_pair1(Type,_Low,_High,_L,_NL) :-
writeln(output,erreur_interval_from_pair1(Type)),
exit_block(abort).
@@ -1062,27 +1079,47 @@ merge_real_pairs([L..H|LP],Low,High,MLP) :-
:- export intervals_intersection/4.
%%:- mode intervals_intersection(++,++,++,-).
intervals_intersection(real,LI1,LI2,NInter) :- !,
- real_intervals_intersection(LI1,LI2,NInter).
+ double_intervals_from_real_rat(LI1,DLI1),
+ double_intervals_from_real_rat(LI2,DLI2),
+ real_intervals_intersection(DLI1,DLI2,NInter).
intervals_intersection(float_simple,LI1,LI2,NInter) :- !,
- real_intervals_intersection(LI1,LI2,NInter).
+ real_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(float_double,LI1,LI2,NInter) :- !,
- real_intervals_intersection(LI1,LI2,NInter).
+ real_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(integer,LI1,LI2,NInter) :- !,
- integer_intervals_intersection(LI1,LI2,NInter).
+ integer_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(int,LI1,LI2,NInter) :- !,
- integer_intervals_intersection(LI1,LI2,NInter).
+ integer_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(int(_),LI1,LI2,NInter) :- !,
- integer_intervals_intersection(LI1,LI2,NInter).
+ integer_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(uint(_),LI1,LI2,NInter) :- !,
- integer_intervals_intersection(LI1,LI2,NInter).
-intervals_intersection(Type,LI1,LI2,NInter) :-
- (Type == none; Type == bool),!,
- %% On ne traite que les enumeres
- enum_intervals_intersection(LI1,LI2,NInter).
+ integer_intervals_intersection(LI1,LI2,NInter).
intervals_intersection(Type,LI1,LI2,NInter) :-
- writeln(output,erreur_intervals_intersection(Type)),
- exit_block(abort).
+ (Type == none; Type == bool),!,
+ % On ne traite que les enumeres
+ enum_intervals_intersection(LI1,LI2,NInter).
+intervals_intersection(Type,_LI1,_LI2,_NInter) :-
+ writeln(output,erreur_intervals_intersection(Type)),
+ exit_block(abort).
+double_intervals_from_real_rat([],[]).
+double_intervals_from_real_rat([I|ListI],[RI|RListI]) :-
+ (I = LI..HI ->
+ (float(LI) ->
+ RLI = LI
+ ; float_of_rat(float_double,rtn,LI,RLI)),
+ (float(HI) ->
+ RHI = HI
+ ; float_of_rat(float_double,rtp,HI,RHI)),
+ RI = RLI..RHI
+ ; (float(I) ->
+ RI = I
+ ; float_of_rat(float_double,rtn,I,RLI),
+ float_of_rat(float_double,rtp,I,RHI),
+ (RLI == RHI ->
+ RI = RLI
+ ; RI = RLI..RHI))),
+ double_intervals_from_real_rat(ListI,RListI).
:- export integer_intervals_intersection/3.
integer_intervals_intersection([],_,[]).
@@ -1123,7 +1160,7 @@ splitted_interval_from_bounds(integer,L,H,LI,EndLI) :- !,
; LI = [L..H|EndLI]).
splitted_interval_from_bounds(real,L,H,LI,EndLI) :- !,
LI = [L..H|EndLI].
-splitted_interval_from_bounds(Type,L,H,LI,EndLI) :-
+splitted_interval_from_bounds(Type,_L,_H,_LI,_EndLI) :-
writeln(output,erreur_splitted_interval_from_bounds(Type)),
exit_block(abort).
@@ -1208,7 +1245,7 @@ gen_intervals_intersection1(Type,I1,LI1,[I2|LI2],NLI1,NLI2,Inter,NInter) :-
NLI2 = LI2,
NInter = Inter)))).
-%% version reelle
+%% version reelle/float/double
:- export real_intervals_intersection/3.
real_intervals_intersection([],_,[]).
real_intervals_intersection([I1|LI1],LI2,NInter) :-
@@ -1252,6 +1289,7 @@ minZ(A,B,C) :-
C = A
; C = B)
; min(A,B,C)).
+
maxZ(A,B,C) :-
((A =:= 0.0,
B =:= 0.0)
@@ -1266,48 +1304,48 @@ maxZ(A,B,C) :-
:- export check_intervals_intersection/2.
%%:- mode check_intervals_intersection(++,++).
check_intervals_intersection([I1|LI1],LI2) :-
- check_intervals_intersection(I1,LI1,LI2,NLI1,NLI2,Found),
- (var(Found) ->
- check_intervals_intersection(NLI1,NLI2)
- ; true).
+ check_intervals_intersection(I1,LI1,LI2,NLI1,NLI2,Found),
+ (var(Found) ->
+ check_intervals_intersection(NLI1,NLI2)
+ ; true).
%%:- mode check_intervals_intersection(++,++,++,-,-,?).
check_intervals_intersection(I1,LI1,[I2|LI2],NLI1,NLI2,Found) :-
- (interval_bounds(I1,L1,H1) ->
- (interval_bounds(I2,L2,H2) ->
- (L1 > H2 ->
- %% On continue
- NLI1 = [I1|LI1],
- NLI2 = LI2
- ; (H1 < L2 ->
- %% On continue
- NLI1 = LI1,
- NLI2 = [I2|LI2]
- ; % L1 =< H2 et H1 >= L2
- %% On a fini
- Found = 1))
- ; %% I2 est un atome
- %% On continue
- NLI1 = LI1,
- NLI2 = [I2|LI2])
- ; %% I1 est un atome (on est dans mfd)
- (interval_bounds(I2,_,_) ->
- %% On continue
- NLI1 = [I1|LI1],
- NLI2 = LI2
- ; %% I1 et I2 sont des atomes
- compare(Order,I1,I2),
- (Order == '=' ->
- %% On a fini
- Found = 1
- ; (Order == '<' ->
- %% On continue
- NLI1 = LI1,
- NLI2 = [I2|LI2]
- ; %% Order = '>'
- %% On continue
- NLI1 = [I1|LI1],
- NLI2 = LI2)))).
+ (interval_bounds(I1,L1,H1) ->
+ (interval_bounds(I2,L2,H2) ->
+ (L1 > H2 ->
+ % On continue
+ NLI1 = [I1|LI1],
+ NLI2 = LI2
+ ; (H1 < L2 ->
+ % On continue
+ NLI1 = LI1,
+ NLI2 = [I2|LI2]
+ ; % L1 =< H2 et H1 >= L2
+ % On a fini
+ Found = 1))
+ ; % I2 est un atome
+ % On continue
+ NLI1 = LI1,
+ NLI2 = [I2|LI2])
+ ; % I1 est un atome (on est dans mfd)
+ (interval_bounds(I2,_,_) ->
+ % On continue
+ NLI1 = [I1|LI1],
+ NLI2 = LI2
+ ; % I1 et I2 sont des atomes
+ compare(Order,I1,I2),
+ (Order == '=' ->
+ % On a fini
+ Found = 1
+ ; (Order == '<' ->
+ % On continue
+ NLI1 = LI1,
+ NLI2 = [I2|LI2]
+ ; % Order = '>'
+ % On continue
+ NLI1 = [I1|LI1],
+ NLI2 = LI2)))).
:- export check_enum_intervals_intersection/2.
%%:- mode check_enum_intervals_intersection(++,++).
diff --git a/Src/COLIBRI/zutils.pl b/Src/COLIBRI/zutils.pl
index 5a5d6d9a4fd5469d3e6620363a44b70fc1ff4802..4d8f3c0f837cde3161d6e3e346953f67d0994a65 100644
--- a/Src/COLIBRI/zutils.pl
+++ b/Src/COLIBRI/zutils.pl
@@ -49,7 +49,7 @@ En deça, c'est le 1 qui gagne, au dessus c'est largement 2 qui gagne
*/
-run_numbits(0, _, _, S) :- !.
+run_numbits(0, _, _, _S) :- !.
run_numbits(N, X, C, S) :-
N > 0,
(C == 1 ->
@@ -98,7 +98,7 @@ numbits_n(C, N, Count) :-
numbits_n(CC, NN, Count)
)).
-at_least_two([A,B|L]).
+at_least_two([_,_|_L]).
:- export is_setbit/2.
is_setbit(N,Indx) :-
diff --git a/tests/sat/issue_50.smt2 b/tests/sat/issue_50.smt2
new file mode 100644
index 0000000000000000000000000000000000000000..e88d1679e001485cb31246988f14145c2b55ab44
--- /dev/null
+++ b/tests/sat/issue_50.smt2
@@ -0,0 +1,22 @@
+;; produced by colibri.drv ;;
+(set-logic ALL)
+(set-info :smt-lib-version 2.6)
+
+
+(define-fun mod1 ((x Int) (y Int)) Int
+ (let ((r (mod x y))) (ite (<= 0 y) r (ite (= r 0) 0 (+ r y)))))
+
+(define-fun in_range1 ((x Int)) Bool
+ (and (<= (- 2147483648) x) (<= x 2147483647)))
+
+
+
+(declare-const x Int)
+
+(assert (and (in_range1 x) (= (mod1 x 2) 0)))
+
+(declare-const x1 Int)
+
+(assert (not (= (mod1 x1 2) 0)))
+
+(check-sat)