diff --git a/Makefile b/Makefile
index 78d9c93da1e1070f1357dbf07f5ca228338a37a0..309ee6e85998f690935644df6aeec0c4750b78fe 100644
--- a/Makefile
+++ b/Makefile
@@ -19,7 +19,8 @@
##########################################################################
all:
- dune build --root=$$(pwd) @install colibri2.opam colibrics.opam colibrilib.opam
+ dune build --root=$$(pwd) @install colibri2.opam colibrics.opam colibrilib.opam \
+ src_colibri2/bin/colibri2_stage0.exe
test:
dune runtest --root=$$(pwd)
diff --git a/src_colibri2/core/colibri2_core.mli b/src_colibri2/core/colibri2_core.mli
index e95a01dfd0ea327835ef9975289d88e04e574a23..fcfdad959bfb868558d72c63831d7bfb7632dd45 100644
--- a/src_colibri2/core/colibri2_core.mli
+++ b/src_colibri2/core/colibri2_core.mli
@@ -128,6 +128,7 @@ and Ground : sig
val empty : t
val distinct_union : t -> t -> t
+ val map_repr : _ Egraph.t -> t -> t
end
and Ty : sig
@@ -219,6 +220,18 @@ and Ground : sig
Dolmen_std.Expr.term_var list ->
Expr.term ->
unit
+ (** [add d sym tys vars def] add the definition [def] for the symbol [sym] *)
+
+ val add_handler :
+ Egraph.wt ->
+ (Egraph.wt ->
+ Dolmen_std.Expr.Term.Const.t ->
+ Dolmen_std.Expr.Ty.Var.t list ->
+ Dolmen_std.Expr.Term.Var.t list ->
+ Expr.Term.t ->
+ unit) ->
+ unit
+ (** Called every time a definition is registered *)
end
module ClosedQuantifier : sig
@@ -288,6 +301,37 @@ and Ground : sig
(** Return the user type. Raise if the ThTerm does not belong to this
module *)
end
+
+ val convert_one_app :
+ Subst.t ->
+ 'a Egraph.t ->
+ Expr.term ->
+ Expr.ty list ->
+ Node.t Colibri2_popop_lib.IArray.t ->
+ Expr.ty ->
+ Node.t
+
+ val convert_one_cst :
+ Subst.t -> 'a Egraph.t -> Dolmen_std.Expr.term_cst -> Node.t
+
+ val convert_one_binder :
+ Subst.t -> 'a Egraph.t -> Expr.binder -> Expr.term -> Expr.ty -> Node.t
+
+ val convert_let_seq :
+ Subst.t ->
+ 'a ->
+ (Dolmen_std.Expr.term_var * Expr.term) list ->
+ Expr.term ->
+ ('a -> Subst.t -> Expr.term -> Node.t) ->
+ Node.t
+
+ val convert_let_par :
+ Subst.t ->
+ 'a ->
+ (Dolmen_std.Expr.term_var * Expr.term) list ->
+ Expr.term ->
+ ('a -> Subst.t -> Expr.term -> Node.t) ->
+ Node.t
end
(** {3 Different Object } *)
@@ -664,6 +708,7 @@ module Datastructure : sig
val find_opt : 'a t -> _ Egraph.t -> key -> 'a option
val mem : 'a t -> _ Egraph.t -> key -> bool
val change : ('a option -> 'a option) -> 'a t -> _ Egraph.t -> key -> unit
+ val iter : f:(key -> 'a -> unit) -> 'a t -> _ Egraph.t -> unit
end
module Hashtbl (S : Colibri2_popop_lib.Popop_stdlib.Datatype) :
@@ -709,6 +754,7 @@ module Datastructure : sig
val push : 'a t -> _ Egraph.t -> 'a -> unit
val iter : f:('a -> unit) -> 'a t -> _ Egraph.t -> unit
val fold : f:('acc -> 'a -> 'acc) -> init:'acc -> 'a t -> _ Egraph.t -> 'acc
+ val exists : f:('a -> bool) -> 'a t -> _ Egraph.t -> bool
val length : 'a t -> _ Egraph.t -> int
val get : 'a t -> _ Egraph.t -> int -> 'a
end
@@ -968,6 +1014,7 @@ module Monad : sig
val getd : ?def:'a -> 'a Dom.Kind.t -> Node.t -> 'a option monad
val setd : 'a Dom.Kind.t -> Node.t -> 'a option monad -> sequence
+ val exec : (Egraph.wt -> unit) -> bool option monad -> sequence
val updd :
(Egraph.wt -> Node.t -> 'a -> unit) -> Node.t -> 'a option monad -> sequence
diff --git a/src_colibri2/core/datastructure.ml b/src_colibri2/core/datastructure.ml
index 8065d2c294e9cd953d07e60a0c66f3c340fe562a..8a04788671e3cb2cb3343f43db05276794fc1919 100644
--- a/src_colibri2/core/datastructure.ml
+++ b/src_colibri2/core/datastructure.ml
@@ -30,6 +30,7 @@ module type Sig = sig
val find_opt: 'a t -> _ Egraph.t -> key -> 'a option
val mem: 'a t -> _ Egraph.t -> key -> bool
val change : ('a option -> 'a option) -> 'a t -> _ Egraph.t -> key -> unit
+ val iter : f:(key -> 'a -> unit) -> 'a t -> _ Egraph.t -> unit
end
module Hashtbl(S:Colibri2_popop_lib.Popop_stdlib.Datatype) : Sig with type key := S.t = struct
@@ -97,6 +98,10 @@ module Hashtbl(S:Colibri2_popop_lib.Popop_stdlib.Datatype) : Sig with type key :
in
S.H.change change h k
+ let iter ~f t d =
+ let h = Egraph.get_unsaved_env d t in
+ S.H.iter (fun k v -> Option.iter (f k) (Context.Ref.get v)) h
+
end
module type Sig2 = sig
@@ -228,6 +233,9 @@ module Push = struct
let fold ~f ~init t d =
Context.Push.fold f init (Egraph.get_unsaved_env d t)
+ let exists ~f t d =
+ Context.Push.exists f (Egraph.get_unsaved_env d t)
+
let length t d = Context.Push.length (Egraph.get_unsaved_env d t)
let get t d i = Context.Push.get (Egraph.get_unsaved_env d t) i
@@ -251,3 +259,51 @@ module Ref = struct
let get t d = Context.Ref.get (Egraph.get_unsaved_env d t)
let set t d v = Context.Ref.set (Egraph.get_unsaved_env d t) v
end
+
+module type Trie = sig
+ type 'a t
+ type key
+
+ val create: 'a Format.printer -> string -> 'a t
+
+ module List : sig
+ val set : 'a t -> _ Egraph.t ->key list -> 'a -> unit
+ val find_def : default:(Context.creator -> 'a) -> 'a t -> _ Egraph.t ->key list -> 'a
+ end
+
+ module Set : sig
+ type set
+
+ val set : 'a t -> _ Egraph.t -> set -> 'a -> unit
+ val find_def : default:(Context.creator -> 'a) -> 'a t -> _ Egraph.t -> set -> 'a
+ end
+end
+
+module Trie (S:Colibri2_popop_lib.Popop_stdlib.Datatype) : Trie
+ with type key := S.t and type Set.set := S.S.t = struct
+
+ module Trie = Context.Trie(S)
+
+ type 'a t = 'a Trie.t Env.Unsaved.t
+
+ let create : type a. a Colibri2_popop_lib.Pp.pp -> _ -> a t = fun pp name ->
+ let module M = struct
+ type t = a Trie.t
+ let name = name end
+ in
+ let key = Env.Unsaved.create (module M) in
+ let init d = Trie.create d in
+ let pp = Trie.pp pp in
+ Env.Unsaved.register ~init ~pp key;
+ key
+
+ module List = struct
+ let set t d l v = Trie.List.set (Egraph.get_unsaved_env d t) l v
+ let find_def ~default t d l = Trie.List.find_def ~default (Egraph.get_unsaved_env d t) l
+ end
+
+ module Set = struct
+ let set t d l v = Trie.Set.set (Egraph.get_unsaved_env d t) l v
+ let find_def ~default t d l = Trie.Set.find_def ~default (Egraph.get_unsaved_env d t) l
+ end
+end
diff --git a/src_colibri2/core/datastructure.mli b/src_colibri2/core/datastructure.mli
index c411f6f263cedff8405cd848f2a90c55049dfe8c..b403340f72a91dc91d6ef283397f629924d589e6 100644
--- a/src_colibri2/core/datastructure.mli
+++ b/src_colibri2/core/datastructure.mli
@@ -32,6 +32,7 @@ module type Sig = sig
val find_opt: 'a t -> _ Egraph.t -> key -> 'a option
val mem: 'a t -> _ Egraph.t -> key -> bool
val change : ('a option -> 'a option) -> 'a t -> _ Egraph.t -> key -> unit
+ val iter : f:(key -> 'a -> unit) -> 'a t -> _ Egraph.t -> unit
end
module Hashtbl (S:Colibri2_popop_lib.Popop_stdlib.Datatype) : Sig with type key := S.t
@@ -76,6 +77,7 @@ module Push: sig
val push: 'a t -> _ Egraph.t -> 'a -> unit
val iter: f:('a -> unit) -> 'a t -> _ Egraph.t -> unit
val fold: f:('acc -> 'a -> 'acc) -> init:'acc -> 'a t -> _ Egraph.t -> 'acc
+ val exists : f:('a -> bool) -> 'a t -> _ Egraph.t -> bool
val length: 'a t -> _ Egraph.t -> int
val get: 'a t -> _ Egraph.t -> int -> 'a
@@ -87,3 +89,25 @@ module Ref: sig
val get: 'a t -> _ Egraph.t -> 'a
val set: 'a t -> _ Egraph.t -> 'a -> unit
end
+
+module type Trie = sig
+ type 'a t
+ type key
+
+ val create: 'a Format.printer -> string -> 'a t
+
+ module List : sig
+ val set : 'a t -> _ Egraph.t ->key list -> 'a -> unit
+ val find_def : default:(Context.creator -> 'a) -> 'a t -> _ Egraph.t ->key list -> 'a
+ end
+
+ module Set : sig
+ type set
+
+ val set : 'a t -> _ Egraph.t -> set -> 'a -> unit
+ val find_def : default:(Context.creator -> 'a) -> 'a t -> _ Egraph.t -> set -> 'a
+ end
+end
+
+module Trie (S:Colibri2_popop_lib.Popop_stdlib.Datatype) : Trie
+ with type key := S.t and type Set.set := S.S.t
diff --git a/src_colibri2/core/demon.ml b/src_colibri2/core/demon.ml
index a5d2d1e805f023e2d71e54a79664852d4ba3c144..e3154bfef07104c453b5abb1ed32d1aafa74854a 100644
--- a/src_colibri2/core/demon.ml
+++ b/src_colibri2/core/demon.ml
@@ -169,7 +169,7 @@ module Simple = struct
end)
module LastEffort = Make (struct
- let name = "Demon.Simple.FixingModel"
+ let name = "Demon.Simple.LastEffort"
let delay = Events.LastEffort 1
end)
@@ -353,10 +353,12 @@ module Monad = struct
| UpdD :
Node.t * (Egraph.wt -> Node.t -> 'a -> unit) * 'a option monad
-> sequence
+ | SExec : (Egraph.wt -> unit) * bool option monad -> sequence
let getv m n = GetV (n, m)
let setv m n f = SetV (n, m, f)
let getd ?def m n = GetD (n, m, def)
+ let exec f m = SExec (f, m)
let exec_ro f m = Exec (f, m)
let setd m n f = SetD (n, m, f)
let updd m n f = UpdD (n, m, f)
@@ -372,6 +374,7 @@ module Monad = struct
| UpdD :
Node.t * (Egraph.wt -> Node.t -> 'a -> unit) * 'a * runable
-> runable
+ | SExec : (Egraph.wt -> unit) * runable -> runable
| Nil : runable
let print_runable = Fmt.nop
@@ -395,6 +398,9 @@ module Monad = struct
| UpdD (n, upd, b, r) ->
upd d n b;
run d r
+ | SExec (g, r) ->
+ g d;
+ run d r
| Nil -> ()
end
@@ -432,6 +438,9 @@ module Monad = struct
| UpdD (n, dom, f) -> (
let v = compute d f in
match v with None -> acc | Some v -> UpdD (n, dom, v, acc))
+ | SExec (g, f) -> (
+ let v = compute d f in
+ match v with None | Some false -> acc | Some true -> SExec (g, acc))
type footprint = {
doms : Node.S.t DomKind.Vector.t;
@@ -469,6 +478,7 @@ module Monad = struct
| SetV (_, _, f) -> attach_aux compute d f
| SetD (_, _, f) -> attach_aux compute d f
| UpdD (_, _, f) -> attach_aux compute d f
+ | SExec (_, f) -> attach_aux compute d f
let attach d ?thterm seq =
let compute d =
diff --git a/src_colibri2/core/demon.mli b/src_colibri2/core/demon.mli
index 857579512325d6293a811f1ce3383ed7df3c57f3..2e9935e63da74d3d61f8196721492e3c36b2a00b 100644
--- a/src_colibri2/core/demon.mli
+++ b/src_colibri2/core/demon.mli
@@ -137,6 +137,7 @@ module Monad : sig
val getd : ?def:'a -> 'a DomKind.t -> Node.t -> 'a option monad
val setd : 'a DomKind.t -> Node.t -> 'a option monad -> sequence
+ val exec : (Egraph.wt -> unit) -> bool option monad -> sequence
val updd :
(Egraph.wt -> Node.t -> 'a -> unit) -> Node.t -> 'a option monad -> sequence
diff --git a/src_colibri2/core/egraph.ml b/src_colibri2/core/egraph.ml
index 0256693c365887386c726a87a249be31f620ae6d..f13c98f25959fb3df42c66462f2e32d4e5f3f2a0 100644
--- a/src_colibri2/core/egraph.ml
+++ b/src_colibri2/core/egraph.ml
@@ -34,8 +34,14 @@ let debug_few = Debug.register_info_flag
~desc:"for the core solver"
"Egraph.few"
-let print_decision = Colibri2_stdlib.Debug.register_info_flag ~desc:"Print@ information@ about@ the@ decisions@ made" "decision"
-let print_contradiction = Colibri2_stdlib.Debug.register_info_flag ~desc:"Print@ information@ about@ the@ contradiction@ found" "contradiction"
+let print_decision =
+ Colibri2_stdlib.Debug.register_info_flag
+ ~desc:"Print@ information@ about@ the@ decisions@ made"
+ "decision"
+let print_contradiction =
+ Colibri2_stdlib.Debug.register_info_flag
+ ~desc:"Print@ information@ about@ the@ contradiction@ found"
+ "contradiction"
let stats_set_dom =
Debug.register_stats_int "Egraph.set_dom/merge"
diff --git a/src_colibri2/core/ground.ml b/src_colibri2/core/ground.ml
index 8ef12c068dbc8fafc412af139dbff9ab5665e9ce..a83c06bcc007894840f8b9f667dd419072ec117e 100644
--- a/src_colibri2/core/ground.ml
+++ b/src_colibri2/core/ground.ml
@@ -61,6 +61,9 @@ module Subst = struct
term =
Expr.Term.Var.M.union (fun _ _ -> assert false) subst1.term subst2.term;
}
+
+ let map_repr d subst =
+ { subst with term = Expr.Term.Var.M.map (Egraph.find_def d) subst.term }
end
module Ty = struct
@@ -319,68 +322,60 @@ module NotTotallyApplied = struct
RegisterThTerm (NotTotallyApplied0) : RegisteredThTerm with type s := s)
end
-let rec convert_and_iter ?(subst = Subst.empty) fg fcq fnt (t : Expr.Term.t) =
- match t.term_descr with
- | Var v -> (
- match Expr.Term.Var.M.find v subst.term with
- | exception Not_found ->
- invalid_arg (Fmt.str "Not_ground: %a" Expr.Term.Var.pp v)
- | n -> n)
- | App (f, tyargs, args) -> (
- let ty = Ty.convert subst.ty t.term_ty in
- match (ty.app.builtin, f.term_descr) with
- | Ty.Arrow, _ | _, (Match _ | App _ | Var _ | Binder _) ->
- let nt =
- NotTotallyApplied.index
- @@ App
- {
- app = convert_and_iter ~subst fg fcq fnt f;
- tyargs = List.map (Ty.convert subst.ty) tyargs;
- args =
- IArray.of_list_map
- ~f:(convert_and_iter ~subst fg fcq fnt)
- args;
- ty = Ty.convert subst.ty t.term_ty;
- }
- in
- fnt nt;
- NotTotallyApplied.node nt
- | _, Cst f ->
- let g =
- ThTerm.index
- @@ {
- Term.app = f;
- tyargs = List.map (Ty.convert subst.ty) tyargs;
- args =
- IArray.of_list_map
- ~f:(convert_and_iter ~subst fg fcq fnt)
- args;
- ty = Ty.convert subst.ty t.term_ty;
- }
- in
- fg g;
- ThTerm.node g)
- | Cst f ->
- let ty_args, args, ty = Expr.Ty.poly_sig f.id_ty in
- if List.is_empty args then (
- assert (List.is_empty ty_args);
- let g =
- ThTerm.index
- @@ {
- Term.app = f;
- tyargs = [];
- args = IArray.empty;
- ty = Ty.convert subst.ty ty;
+let rec convert_one_app_and_iter d (f : Expr.Term.t) tyargs args ty
+ (subst : Subst.t) fg fcq fnt =
+ let ty = Ty.convert subst.ty ty in
+ match (ty.app.builtin, f.term_descr) with
+ | Ty.Arrow, _ | _, (Match _ | App _ | Var _ | Binder _) ->
+ let nt =
+ NotTotallyApplied.index
+ @@ App
+ {
+ app = convert_and_iter fg fcq fnt d subst f;
+ tyargs = List.map (Ty.convert subst.ty) tyargs;
+ args;
+ ty;
}
- in
- fg g;
- ThTerm.node g)
- else
- let nt = NotTotallyApplied.index @@ Cst f in
- fnt nt;
- NotTotallyApplied.node nt
- | Expr.Binder ((Exists (ty_vars, term_vars) as b), body)
- | Expr.Binder ((Forall (ty_vars, term_vars) as b), body) ->
+ in
+ fnt d nt;
+ NotTotallyApplied.node nt
+ | _, Cst f ->
+ let g =
+ ThTerm.index
+ @@ {
+ Term.app = f;
+ tyargs = List.map (Ty.convert subst.ty) tyargs;
+ args;
+ ty;
+ }
+ in
+ fg d g;
+ ThTerm.node g
+
+and convert_one_cst_and_iter d (f : Expr.Term.Const.t) (subst : Subst.t) fg fnt
+ =
+ let ty_args, args, ty = Expr.Ty.poly_sig f.id_ty in
+ if List.is_empty args then (
+ assert (List.is_empty ty_args);
+ let g =
+ ThTerm.index
+ @@ {
+ Term.app = f;
+ tyargs = [];
+ args = IArray.empty;
+ ty = Ty.convert subst.ty ty;
+ }
+ in
+ fg d g;
+ ThTerm.node g)
+ else
+ let nt = NotTotallyApplied.index @@ Cst f in
+ fnt d nt;
+ NotTotallyApplied.node nt
+
+and convert_one_binder_and_iter d (b : Expr.binder) body ty subst fcq fnt =
+ match b with
+ | Exists (ty_vars, term_vars) | Forall (ty_vars, term_vars) ->
let binder =
match b with
| Exists _ -> ClosedQuantifier0.Exists
@@ -390,56 +385,76 @@ let rec convert_and_iter ?(subst = Subst.empty) fg fcq fnt (t : Expr.Term.t) =
let cq =
ClosedQuantifier.index @@ { binder; ty_vars; term_vars; body; subst }
in
- fcq cq;
+ fcq d cq;
ClosedQuantifier.node cq
- | Expr.Binder (Lambda (ty_vars, term_vars), body) ->
+ | Lambda (ty_vars, term_vars) ->
let nt =
NotTotallyApplied.index
@@ Lambda
- {
- ty_vars;
- term_vars;
- body;
- subst;
- ty = Ty.convert subst.ty t.term_ty;
- }
+ { ty_vars; term_vars; body; subst; ty = Ty.convert subst.ty ty }
in
- fnt nt;
+ fnt d nt;
NotTotallyApplied.node nt
- | Expr.Binder (Let_seq l, body) ->
- let subst_term =
- List.fold_left
- (fun term (v, t) ->
- let n =
- convert_and_iter ~subst:{ term; ty = subst.ty } fg fcq fnt t
- in
- Expr.Term.Var.M.add v n term)
- subst.term l
+ | Let_seq _ | Let_par _ -> invalid_arg "convert_one_binder: let_* given"
+
+and convert_let_seq_and_iter d l body (subst : Subst.t) convert_and_iter =
+ let subst_term =
+ List.fold_left
+ (fun term (v, t) ->
+ let n = convert_and_iter d { Subst.term; ty = subst.ty } t in
+ Expr.Term.Var.M.add v n term)
+ subst.term l
+ in
+ convert_and_iter d { term = subst_term; ty = subst.ty } body
+
+and convert_let_par_and_iter d l body (subst : Subst.t) convert_and_iter =
+ let subst_term =
+ List.fold_left
+ (fun term (v, t) ->
+ let n = convert_and_iter d subst t in
+ Expr.Term.Var.M.add v n term)
+ subst.term l
+ in
+ convert_and_iter d { term = subst_term; ty = subst.ty } body
+
+and convert_and_iter fg fcq fnt d subst (t : Expr.Term.t) =
+ match t.term_descr with
+ | Var v -> (
+ match Expr.Term.Var.M.find v subst.term with
+ | exception Not_found ->
+ invalid_arg (Fmt.str "Not_ground: %a" Expr.Term.Var.pp v)
+ | n -> n)
+ | App (f, tyargs, args) ->
+ let args =
+ IArray.of_list_map ~f:(convert_and_iter fg fcq fnt d subst) args
in
- convert_and_iter
- ~subst:{ term = subst_term; ty = subst.ty }
- fg fcq fnt body
+ convert_one_app_and_iter d f tyargs args t.term_ty subst fg fcq fnt
+ | Cst f -> convert_one_cst_and_iter d f subst fg fnt
+ | Expr.Binder (((Exists _ | Forall _ | Lambda _) as b), body) ->
+ convert_one_binder_and_iter d b body t.term_ty subst fcq fnt
+ | Expr.Binder (Let_seq l, body) ->
+ convert_let_seq_and_iter d l body subst (convert_and_iter fg fcq fnt)
| Expr.Binder (Let_par l, body) ->
- let subst_term =
- List.fold_left
- (fun term (v, t) ->
- let n = convert_and_iter ~subst fg fcq fnt t in
- Expr.Term.Var.M.add v n term)
- subst.term l
- in
- convert_and_iter
- ~subst:{ term = subst_term; ty = subst.ty }
- fg fcq fnt body
- | Expr.Match (_, _) -> assert false
+ convert_let_par_and_iter d l body subst (convert_and_iter fg fcq fnt)
+ | Expr.Match (_, _) -> invalid_arg "match from dolmen not implemented"
(* TODO convert to one multitest like
the match of why3 and projection *)
-let convert ?subst d e =
- convert_and_iter
- (fun th -> Choice_group.make_choosable d (ThTerm.thterm th))
- (fun th -> Choice_group.make_choosable d (ClosedQuantifier.thterm th))
- (fun th -> Choice_group.make_choosable d (NotTotallyApplied.thterm th))
- ?subst e
+let fg d th = Choice_group.make_choosable d (ThTerm.thterm th)
+let fcq d th = Choice_group.make_choosable d (ClosedQuantifier.thterm th)
+let fnt d th = Choice_group.make_choosable d (NotTotallyApplied.thterm th)
+let convert ?(subst = Subst.empty) d e = convert_and_iter fg fcq fnt d subst e
+
+let convert_one_app subst d a b c e =
+ convert_one_app_and_iter d a b c e subst fg fcq fnt
+
+let convert_one_cst subst d a = convert_one_cst_and_iter d a subst fg fnt
+
+let convert_one_binder subst d a b c =
+ convert_one_binder_and_iter d a b c subst fcq fnt
+
+let convert_let_seq subst d a b iter = convert_let_seq_and_iter d a b subst iter
+let convert_let_par subst d a b iter = convert_let_par_and_iter d a b subst iter
let apply _ (f : Expr.Term.Const.t) tyargs args =
let rec apply_ty subst tyargs (ty : Expr.Ty.t) =
@@ -469,9 +484,12 @@ module Defs = struct
let pp_fundef _ _ = ()
let fundefs = Expr.Term.Const.HC.create pp_fundef "SynTerm.fundefs"
+ let handler = Datastructure.Push.create Fmt.nop "Interp.check"
+ let add_handler d f = Datastructure.Push.push handler d f
let add d tc tyl tvl body =
- Expr.Term.Const.HC.set fundefs d tc { tyl; tvl; body }
+ Expr.Term.Const.HC.set fundefs d tc { tyl; tvl; body };
+ Datastructure.Push.iter handler d ~f:(fun f -> f d tc tyl tvl body)
module ThTermH = Datastructure.Hashtbl (ThTerm)
@@ -509,8 +527,8 @@ module Defs = struct
in
let group = Choice_group.create d in
let n =
- convert_and_iter ~subst
- (fun th ->
+ convert_and_iter
+ (fun d th ->
if level <= level_dec then
Choice_group.make_choosable d (ThTerm.thterm th)
else Choice_group.add_to_group d (ThTerm.thterm th) group;
@@ -521,14 +539,14 @@ module Defs = struct
| _ ->
if not (ThTermH.mem levels d th) then
ThTermH.set levels d th (1 + level)))
- (fun th ->
+ (fun d th ->
if level <= level_dec then
Choice_group.make_choosable d (ClosedQuantifier.thterm th)
else
Choice_group.add_to_group d
(ClosedQuantifier.thterm th)
group)
- (fun th ->
+ (fun d th ->
if level <= level_dec then
Choice_group.make_choosable d
(NotTotallyApplied.thterm th)
@@ -536,7 +554,7 @@ module Defs = struct
Choice_group.add_to_group d
(NotTotallyApplied.thterm th)
group)
- fundef.body
+ d subst fundef.body
in
if level_dec < level && level <= level_dec_delayed then
Demon.Simple.LastEffort.schedule_immediately d (fun d ->
@@ -549,51 +567,59 @@ end
let registered_converter = Datastructure.Push.create Fmt.nop "Ground.converters"
let register_converter d f = Datastructure.Push.push registered_converter d f
-let dom_tys =
- DomKind.create
- (module struct
- type nonrec t = Ty.S.t
-
- let name = "Ground.tys"
- end)
-
-let () =
- Egraph.register_dom
- (module struct
- include Ty.S
-
- let key = dom_tys
- let merged tys0 tys1 = Option.equal equal tys0 tys1
-
- let merge d (tys0, n0) (tys1, n1) _ =
- let s =
- Ty.S.union
- (Base.Option.value ~default:Ty.S.empty tys0)
- (Base.Option.value ~default:Ty.S.empty tys1)
- in
- Egraph.set_dom d key n0 s;
- Egraph.set_dom d key n1 s
- end)
-
-let tys d n = Base.Option.value ~default:Ty.S.empty (Egraph.get_dom d dom_tys n)
+module Tys : sig
+ val tys : _ Egraph.t -> Node.t -> Ty.S.t
+ val add_ty : Egraph.wt -> Node.t -> Ty.t -> unit
+end = struct
+ let dom_tys =
+ DomKind.create
+ (module struct
+ type nonrec t = Ty.S.t
+
+ let name = "Ground.tys"
+ end)
+
+ let () =
+ Egraph.register_dom
+ (module struct
+ include Ty.S
+
+ let key = dom_tys
+ let merged tys0 tys1 = Option.equal equal tys0 tys1
+
+ let merge d (tys0, n0) (tys1, n1) _ =
+ let s =
+ Ty.S.union
+ (Base.Option.value ~default:Ty.S.empty tys0)
+ (Base.Option.value ~default:Ty.S.empty tys1)
+ in
+ Egraph.set_dom d key n0 s;
+ Egraph.set_dom d key n1 s
+ end)
+
+ let tys d n =
+ Base.Option.value ~default:Ty.S.empty (Egraph.get_dom d dom_tys n)
+
+ let add_ty d n ty =
+ match Egraph.get_dom d dom_tys n with
+ | None -> Egraph.set_dom d dom_tys n (Ty.S.singleton ty)
+ | Some tys -> (
+ match Ty.S.add_new Exit ty tys with
+ | exception Exit -> ()
+ | tys -> Egraph.set_dom d dom_tys n tys)
+end
-let add_ty d n ty =
- match Egraph.get_dom d dom_tys n with
- | None -> Egraph.set_dom d dom_tys n (Ty.S.singleton ty)
- | Some tys -> (
- match Ty.S.add_new Exit ty tys with
- | exception Exit -> ()
- | tys -> Egraph.set_dom d dom_tys n tys)
+let tys = Tys.tys
let init d =
Demon.Simple.attach_reg_sem d ThTerm.key (fun d g ->
let n = ThTerm.node g in
let s = ThTerm.sem g in
- add_ty d n s.ty;
+ Tys.add_ty d n s.ty;
Defs.converter d g;
Datastructure.Push.iter registered_converter d ~f:(fun f -> f d g));
Demon.Simple.attach_reg_sem d ClosedQuantifier.key (fun d g ->
let n = ClosedQuantifier.node g in
- add_ty d n Ty.bool)
+ Tys.add_ty d n Ty.bool)
include (ThTerm : RegisteredThTerm with type s := s and type t = ThTerm.t)
diff --git a/src_colibri2/core/ground.mli b/src_colibri2/core/ground.mli
index 3d8493ce3a8a105ab1c1cba65cf4356e44c00cfe..c331cda8a3d81f84bd78d25fc1aeab673565cf2a 100644
--- a/src_colibri2/core/ground.mli
+++ b/src_colibri2/core/ground.mli
@@ -40,6 +40,7 @@ module Subst : sig
val empty : t
val distinct_union : t -> t -> t
+ val map_repr : _ Egraph.t -> t -> t
end
module Ty : sig
@@ -114,12 +115,23 @@ val tys : _ Egraph.t -> Node.t -> Ty.S.t
module Defs : sig
val add :
Egraph.wt ->
- Dolmen_std.Expr.term_cst ->
- Dolmen_std.Expr.ty_var list ->
- Dolmen_std.Expr.term_var list ->
- Expr.term ->
+ Dolmen_std.Expr.Term.Const.t ->
+ Dolmen_std.Expr.Ty.Var.t list ->
+ Dolmen_std.Expr.Term.Var.t list ->
+ Expr.Term.t ->
unit
(** [add d sym tys vars def] add the definition [def] for the symbol [sym] *)
+
+ val add_handler :
+ Egraph.wt ->
+ (Egraph.wt ->
+ Dolmen_std.Expr.Term.Const.t ->
+ Dolmen_std.Expr.Ty.Var.t list ->
+ Dolmen_std.Expr.Term.Var.t list ->
+ Expr.Term.t ->
+ unit) ->
+ unit
+ (** Called every time a definition is registered *)
end
module ClosedQuantifier : sig
@@ -157,10 +169,42 @@ module NotTotallyApplied : sig
end
val convert_and_iter :
- ?subst:Subst.t ->
- (t -> unit) ->
- (ClosedQuantifier.t -> unit) ->
- (NotTotallyApplied.t -> unit) ->
+ ('a -> t -> unit) ->
+ ('a -> ClosedQuantifier.t -> unit) ->
+ ('a -> NotTotallyApplied.t -> unit) ->
+ 'a ->
+ Subst.t ->
Expr.Term.t ->
Node.t
(** Iter on the new ground terms when converting, bottom_up *)
+
+val convert_one_app :
+ Subst.t ->
+ 'a Egraph.t ->
+ Expr.term ->
+ Expr.ty list ->
+ Node.t IArray.t ->
+ Expr.ty ->
+ Node.t
+
+val convert_one_cst :
+ Subst.t -> 'a Egraph.t -> Dolmen_std.Expr.term_cst -> Node.t
+
+val convert_one_binder :
+ Subst.t -> 'a Egraph.t -> Expr.binder -> Expr.term -> Expr.ty -> Node.t
+
+val convert_let_seq :
+ Subst.t ->
+ 'a ->
+ (Dolmen_std.Expr.term_var * Expr.term) list ->
+ Expr.term ->
+ ('a -> Subst.t -> Expr.term -> Node.t) ->
+ Node.t
+
+val convert_let_par :
+ Subst.t ->
+ 'a ->
+ (Dolmen_std.Expr.term_var * Expr.term) list ->
+ Expr.term ->
+ ('a -> Subst.t -> Expr.term -> Node.t) ->
+ Node.t
diff --git a/src_colibri2/core/interp.ml b/src_colibri2/core/interp.ml
index a65a4a91bfaa2c72e69ddceebe140f060af7cacd..eb5db96ac1e8cff792125fe83589238151ded222 100644
--- a/src_colibri2/core/interp.ml
+++ b/src_colibri2/core/interp.ml
@@ -333,7 +333,7 @@ let check_not_totally_applied d =
let interp d e =
let n =
Ground.convert_and_iter
- (fun g ->
+ (fun d g ->
check_args d g;
let n = Ground.node g in
Egraph.register d n;
@@ -346,7 +346,7 @@ let interp d e =
Egraph.register d n;
Egraph.set_value d n v;
Egraph.flush_internal d))
- (fun g ->
+ (fun d g ->
let n = Ground.ClosedQuantifier.node g in
Egraph.register d n;
if Option.is_none (Egraph.get_value d n) then (
@@ -358,7 +358,7 @@ let interp d e =
Egraph.register d n;
Egraph.set_value d n v;
Egraph.flush_internal d))
- (fun g ->
+ (fun d g ->
let n = Ground.NotTotallyApplied.node g in
Egraph.register d n;
if Option.is_none (Egraph.get_value d n) then (
@@ -370,7 +370,7 @@ let interp d e =
Egraph.register d n;
Egraph.set_value d n v;
Egraph.flush_internal d))
- e
+ d Ground.Subst.empty e
in
assert (Option.is_some (Egraph.get_value d n));
Base.Option.value_exn (Egraph.get_value d n)
diff --git a/src_colibri2/core/structures/nodes.ml b/src_colibri2/core/structures/nodes.ml
index 477e0d0769439c1789d2a39a71ade0f54f01b2d6..7ce6396cd7439556ddc0cabb27c364f06d2d4b50 100644
--- a/src_colibri2/core/structures/nodes.ml
+++ b/src_colibri2/core/structures/nodes.ml
@@ -53,6 +53,8 @@ module Node = struct
(** remove the empty string *)
let () = DStr.H.add used_names "" 0
+ (* let () = DStr.H.add used_names "281" 0 *)
+
let pp fmt x =
Format.pp_print_char fmt '@';
Format.pp_print_string fmt (Simple_vector.get names (tag x))
diff --git a/src_colibri2/solver/input.ml b/src_colibri2/solver/input.ml
index b0c90b1456b9053170963e6b4ffe598ea5148c91..00d373505afec9c396c0cdb01557a0ae565bf6fb 100644
--- a/src_colibri2/solver/input.ml
+++ b/src_colibri2/solver/input.ml
@@ -353,7 +353,10 @@ let handle_stmt ?(show_check_sat_result = true) ?(show_steps = false)
match args with
| [ { term = Symbol { name = Simple i; _ }; _ } ] -> (
match int_of_string i with
- | i -> Context.Ref.set st.solve_state.step_limit (Some i)
+ | i ->
+ (** only if there is already a step limit *)
+ if Option.is_some (Context.Ref.get st.solve_state.step_limit) then
+ Context.Ref.set st.solve_state.step_limit (Some i)
| exception _ -> error st loc expected_integer_for_option ())
| _ -> error st loc expected_integer_for_option ())
| `Set_option _ -> ()
diff --git a/src_colibri2/solver/scheduler.ml b/src_colibri2/solver/scheduler.ml
index 5c27d24d584a81a03af71962a9abd586426a0c2e..6adbd53951cad76c09afdcdeafc6e32e933f571a 100644
--- a/src_colibri2/solver/scheduler.ml
+++ b/src_colibri2/solver/scheduler.ml
@@ -310,7 +310,7 @@ let push kind t =
(** Go to and remove the backtrack point *)
let pop_to t prev =
- Debug.dprintf4 debug_pushpop "[Scheduler] pop from %a : %a" print_level t
+ Debug.dprintf4 debug_pushpop "[Scheduler] pop from %a: %a" print_level t
print_position_in_tree t;
t.prev_scheduler_state <- prev.pre_prev_scheduler_state;
t.level <- prev.pre_level;
@@ -321,7 +321,7 @@ let pop_to t prev =
| [] -> [ min_int ]
| i :: l -> (i + 1) :: l);
Backtrackable.draw_graph t.solver_state;
- Debug.dprintf4 debug_pushpop "[Scheduler] pop to %a: %a" print_level t
+ Debug.dprintf4 debug_pushpop "[Scheduler] pop to %a: %a" print_level t
print_position_in_tree t
(** only fix model *)
@@ -454,11 +454,16 @@ let learning t =
let conflict_analysis ~no_learning t =
Option.iter
(fun v ->
- Debug.dprintf3 debug_learn "[Learnt|%i] %a is useful"
- v.PrioLastEffort.Att.id Events.pp_daemon_key v.PrioLastEffort.Att.v;
+ let debug msg =
+ Debug.dprintf4 debug_learn "[Learnt|%i] %a is useful%s"
+ v.PrioLastEffort.Att.id Events.pp_daemon_key v.PrioLastEffort.Att.v
+ msg
+ in
PrioLastEffort.change t.lasteffort v 2.;
- if PrioLastEffort.get_prio t.lasteffort v = 16. then
- Context.Clicket.push t.last_effort_learnt v.v)
+ if PrioLastEffort.get_prio t.lasteffort v = 16. then (
+ Context.Clicket.push t.last_effort_learnt v.v;
+ debug " and is now learnt")
+ else debug "")
t.last_effort_made;
Option.iter
(fun v ->
@@ -550,7 +555,6 @@ let[@inline always] protect_against_contradiction ~no_learning t f g =
| r -> g r
let run_one_step_propagation ~nodec t =
- Debug.incr stats_step;
match Context.TimeWheel.next t.daemons with
| Some att ->
Debug.incr stats_propa;
@@ -621,6 +625,7 @@ let run_one_step_fix_model ~nodec t =
let run_one_step ~nodec t =
t.steps <- t.steps + 1;
+ Debug.incr stats_step;
Debug.dprintf1 debug "[Scheduler] Step %i" t.steps;
match Context.Ref.get t.solve_step with
| Propagate -> (
diff --git a/src_colibri2/stdlib/context.ml b/src_colibri2/stdlib/context.ml
index 71c62c8a0d870749b334dcbceb6a10a242405fb5..951ebaf7379928f9ea469e45f229f38a5932aa9c 100644
--- a/src_colibri2/stdlib/context.ml
+++ b/src_colibri2/stdlib/context.ml
@@ -294,6 +294,10 @@ module Push = struct
refresh t;
Vector.fold f acc t.v
+ let exists f t =
+ refresh t;
+ Vector.exists f t.v
+
let length t =
refresh t;
Vector.length t.v
@@ -460,17 +464,28 @@ module type HashtblWithDefault = sig
type key
val create : creator -> (creator -> 'a) -> 'a t
+ val pp : 'a Fmt.t -> 'a t Fmt.t
val set : 'a t -> key -> 'a -> unit
val find : 'a t -> key -> 'a
val change : ('a -> 'a) -> 'a t -> key -> unit
end
-module HashtblWithDefault (S : Colibri2_popop_lib.Popop_stdlib.Datatype) :
- HashtblWithDefault with type key := S.t = struct
+module HashtblWithDefault (S : Colibri2_popop_lib.Popop_stdlib.Datatype) : sig
+ include HashtblWithDefault
+
+ val find_aux : 'a t -> key -> 'a Ref.t
+end
+with type key := S.t = struct
type 'a t = { h : 'a Ref.t S.H.t; def : creator -> 'a; creator : creator }
let create creator def = { h = S.H.create 5; def; creator }
+ let pp pp =
+ Fmt.(
+ iter_bindings ~sep:comma
+ (fun f t -> S.H.iter (fun k v -> f k (Ref.get v)) t.h)
+ (pair S.pp pp))
+
let find_aux t k =
match S.H.find_opt t.h k with
| Some r -> r
@@ -566,3 +581,121 @@ module Clicket = struct
let pp ?sep pp fmt v = Vector.pp ?pp_sep:sep pp fmt v.v
end
+
+type 'k fold = { fold : 'a. ('a -> 'k -> 'a) -> 'a -> 'a }
+
+module type Trie = sig
+ type 'a t
+ type key
+
+ val create : creator -> 'a t
+ val pp : 'a Fmt.t -> 'a t Fmt.t
+
+ module List : sig
+ val set : 'a t -> key list -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> key list -> 'a
+ end
+
+ module Set : sig
+ type set
+
+ val set : 'a t -> set -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> set -> 'a
+ end
+
+ module Fold : sig
+ val set : 'a t -> key fold -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> key fold -> 'a
+ val memo : default:(creator -> 'a) -> 'a t -> key fold -> 'a
+ end
+end
+
+module Trie (S : Colibri2_popop_lib.Popop_stdlib.Datatype) :
+ Trie with type key := S.t and type Set.set := S.S.t = struct
+ module H = HashtblWithDefault (S)
+
+ type 'a node =
+ | Empty
+ | Value of 'a
+ | Node of 'a node H.t
+ | NodeValue of 'a * 'a node H.t
+
+ type 'a t = 'a node Ref.t
+
+ let create c = Ref.create c Empty
+
+ let pp pp fmt t =
+ let rec aux fmt c =
+ match c with
+ | Empty -> ()
+ | Value v -> pp fmt v
+ | Node h -> H.pp aux fmt h
+ | NodeValue (v, h) ->
+ pp fmt v;
+ H.pp aux fmt h
+ in
+ aux fmt (Ref.get t)
+
+ module Fold = struct
+ let find_aux t { fold } =
+ let aux acc k =
+ match Ref.get acc with
+ | Empty ->
+ let h = H.create (Ref.creator acc) (fun _ -> Empty) in
+ Ref.set acc (Node h);
+ H.find_aux h k
+ | Value x ->
+ let h = H.create (Ref.creator acc) (fun _ -> Empty) in
+ Ref.set acc (NodeValue (x, h));
+ H.find_aux h k
+ | Node h | NodeValue (_, h) -> H.find_aux h k
+ in
+ let acc = fold aux t in
+ acc
+ [@@inline]
+
+ let set t fold v =
+ let r = find_aux t fold in
+ match Ref.get r with
+ | Empty -> Ref.set r (Value v)
+ | Value v' -> if Base.phys_equal v v' then Ref.set r (Value v)
+ | Node h | NodeValue (_, h) -> Ref.set r (NodeValue (v, h))
+ [@@inline]
+
+ let find_def ~default t fold =
+ let r = find_aux t fold in
+ match Ref.get r with
+ | Empty | Node _ -> default (Ref.creator r)
+ | Value v | NodeValue (v, _) -> v
+ [@@inline]
+
+ let memo ~default t fold =
+ let r = find_aux t fold in
+ match Ref.get r with
+ | Empty ->
+ let v = default (Ref.creator r) in
+ Ref.set r (Value v);
+ v
+ | Node h ->
+ let v = default (Ref.creator r) in
+ Ref.set r (NodeValue (v, h));
+ v
+ | Value v | NodeValue (v, _) -> v
+ [@@inline]
+ end
+
+ module List = struct
+ let set t l v =
+ Fold.set t { fold = (fun f acc -> List.fold_left f acc l) } v
+
+ let find_def ~default t l =
+ Fold.find_def ~default t { fold = (fun f acc -> List.fold_left f acc l) }
+ end
+
+ module Set = struct
+ let set t l v = Fold.set t { fold = (fun f acc -> S.S.fold_left f acc l) } v
+
+ let find_def ~default t l =
+ Fold.find_def ~default t { fold = (fun f acc -> S.S.fold_left f acc l) }
+ end
+end
diff --git a/src_colibri2/stdlib/context.mli b/src_colibri2/stdlib/context.mli
index 1341afb3843ba3308148d7860a693b61f4704a9a..d787183ee4a3aae553290fca7741c6a3c2489f76 100644
--- a/src_colibri2/stdlib/context.mli
+++ b/src_colibri2/stdlib/context.mli
@@ -166,6 +166,7 @@ module Push : sig
val push : 'a t -> 'a -> unit
val iter : ('a -> unit) -> 'a t -> unit
val fold : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc
+ val exists : ('a -> bool) -> 'a t -> bool
val length : 'a t -> int
val get : 'a t -> int -> 'a
@@ -227,6 +228,7 @@ module type HashtblWithDefault = sig
type key
val create : creator -> (creator -> 'a) -> 'a t
+ val pp : 'a Fmt.t -> 'a t Fmt.t
val set : 'a t -> key -> 'a -> unit
val find : 'a t -> key -> 'a
val change : ('a -> 'a) -> 'a t -> key -> unit
@@ -266,3 +268,36 @@ module type Clicket = sig
end
module Clicket : Clicket
+
+type 'k fold = { fold : 'a. ('a -> 'k -> 'a) -> 'a -> 'a }
+
+module type Trie = sig
+ type 'a t
+ type key
+
+ val create : creator -> 'a t
+ val pp : 'a Fmt.t -> 'a t Fmt.t
+
+ module List : sig
+ val set : 'a t -> key list -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> key list -> 'a
+ end
+
+ module Set : sig
+ type set
+
+ val set : 'a t -> set -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> set -> 'a
+ end
+
+ module Fold : sig
+ val set : 'a t -> key fold -> 'a -> unit
+ val find_def : default:(creator -> 'a) -> 'a t -> key fold -> 'a
+
+ val memo : default:(creator -> 'a) -> 'a t -> key fold -> 'a
+ (** find and add default if not present *)
+ end
+end
+
+module Trie (S : Colibri2_popop_lib.Popop_stdlib.Datatype) :
+ Trie with type key := S.t and type Set.set := S.S.t
diff --git a/src_colibri2/tests/solve/all/sat/dune.inc b/src_colibri2/tests/solve/all/sat/dune.inc
index b36ad2c81748d1665718cdc7dd13459fa99be10d..8f0f349d0f392e98adde6b553eb95e187cfbfe77 100644
--- a/src_colibri2/tests/solve/all/sat/dune.inc
+++ b/src_colibri2/tests/solve/all/sat/dune.inc
@@ -5,5 +5,8 @@
--dont-print-result %{dep:div_abs2.smt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status sat --learning --dont-print-result %{dep:div_abs2.smt2})) (package colibri2))
(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status sat
+--dont-print-result %{dep:test_sqrt_assert_KO_Why3_Colibri2_n_a.psmt2})) (package colibri2))
+(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status sat --learning --dont-print-result %{dep:test_sqrt_assert_KO_Why3_Colibri2_n_a.psmt2})) (package colibri2))
+(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status sat
--dont-print-result %{dep:union-Union-is_singletonqtvc_2.psmt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status sat --learning --dont-print-result %{dep:union-Union-is_singletonqtvc_2.psmt2})) (package colibri2))
diff --git a/src_colibri2/tests/solve/all/sat/test_sqrt_assert_KO_Why3_Colibri2_n_a.psmt2 b/src_colibri2/tests/solve/all/sat/test_sqrt_assert_KO_Why3_Colibri2_n_a.psmt2
new file mode 100644
index 0000000000000000000000000000000000000000..f22237ac677d4a87f57f0f31084def7044e274b6
--- /dev/null
+++ b/src_colibri2/tests/solve/all/sat/test_sqrt_assert_KO_Why3_Colibri2_n_a.psmt2
@@ -0,0 +1,8 @@
+;; produced by local colibri2.drv ;;
+(set-logic ALL)
+(set-info :smt-lib-version 2.6)
+
+;; sqrt_0
+(assert (= (colibri_sqrt 0.0) 0.0))
+
+(check-sat)
diff --git a/src_colibri2/tests/solve/all/unknown/dune b/src_colibri2/tests/solve/all/unknown/dune
new file mode 100644
index 0000000000000000000000000000000000000000..b83fe9c3ebfd43d0533cb0207aee56afe31582ce
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unknown/dune
@@ -0,0 +1,13 @@
+(include dune.inc)
+
+(rule
+ (alias runtest)
+ (deps
+ (glob_files *.cnf)
+ (glob_files *.smt2)
+ (glob_files *.psmt2))
+ (action
+ (with-stdout-to
+ dune.inc
+ (run %{exe:../../../generate_tests/generate_dune_tests.exe} . unknown)))
+ (mode promote))
diff --git a/src_colibri2/tests/solve/all/unknown/dune.inc b/src_colibri2/tests/solve/all/unknown/dune.inc
new file mode 100644
index 0000000000000000000000000000000000000000..5d1390b3a59b077188a033370f2eff5a3ab2c4ce
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unknown/dune.inc
@@ -0,0 +1,3 @@
+(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unknown
+--dont-print-result %{dep:float_interval-GenericFloat-div_finite_rev_1.psmt2})) (package colibri2))
+(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unknown --learning --dont-print-result %{dep:float_interval-GenericFloat-div_finite_rev_1.psmt2})) (package colibri2))
diff --git a/src_colibri2/tests/solve/all/unknown/float_interval-GenericFloat-div_finite_rev_1.psmt2 b/src_colibri2/tests/solve/all/unknown/float_interval-GenericFloat-div_finite_rev_1.psmt2
new file mode 100644
index 0000000000000000000000000000000000000000..5ba2215d99dcb78839bc46757718304cf3a18ee3
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unknown/float_interval-GenericFloat-div_finite_rev_1.psmt2
@@ -0,0 +1,118 @@
+;; produced by local colibri2.drv ;;
+(set-logic ALL)
+(set-info :smt-lib-version 2.6)
+;;; SMT-LIB2: integer arithmetic
+;;; SMT-LIB2: real arithmetic
+
+;; infix *.
+(declare-fun infix_asdt (Real
+ Real) Real)
+
+;; infix >=.
+(declare-fun infix_gteqdt (Real
+ Real) Bool)
+
+(declare-datatypes ((tuple1 1))
+ ((par (a) ((Tuple1 (Tuple1_proj_1 a))))))
+
+(declare-sort finite 0)
+
+;; r
+(declare-fun r (finite) Real)
+
+;; mk_finite
+(declare-fun mk_finite (Real) finite)
+
+(declare-datatypes ((t 0))
+ (((Zero (Zero_proj_1 Bool)) (Infinity (Infinity_proj_1 Bool))
+ (Finite (Finite_proj_1 finite)))))
+
+;; zeroF
+(define-fun zeroF () t (Zero false))
+
+;; prefix .-
+(declare-fun prefix_dtmn (t) t)
+
+;; to_real
+(declare-fun to_real1 (t) Real)
+
+;; is_positive
+(declare-fun is_positive (t) Bool)
+
+(declare-datatypes ((classify 0))
+ (((Is_normal) (Is_subnormal) (Is_zero) (Is_infinite))))
+
+;; first_normal
+(declare-fun first_normal () Real)
+
+;; classify
+(declare-fun classify1 (t) classify)
+
+(declare-datatypes ((tuple2 2))
+ ((par (a1 a2) ((Tuple2 (Tuple2_proj_1 a1)(Tuple2_proj_2 a2))))))
+
+;; infix .=
+(declare-fun infix_dteq (t
+ t) Bool)
+
+;; is_zero
+(define-fun is_zero ((f t)) Bool ((_ is Zero) f))
+
+;; is_finite
+(define-fun is_finite ((f t)) Bool
+ (ite ((_ is Zero) f) true (ite ((_ is Finite) f) true (ite ((_ is Infinity) f) false false))))
+
+;; zeroF_is_positive
+(assert (is_positive zeroF))
+
+;; zeroF_is_zero
+(assert (is_zero zeroF))
+
+;; same_sign
+ (define-fun same_sign ((x t) (y t)) Bool
+ (or
+ (and (is_positive x) (is_positive y))
+ (and (not (is_positive x)) (not (is_positive y)))))
+;;(declare-fun same_sign (t t) Bool)
+
+
+(assert (not (is_positive (Zero true))))
+(assert (is_finite (Zero true)))
+
+(assert (not (same_sign zeroF (prefix_dtmn zeroF))))
+(assert (not (same_sign (Zero false) (Zero true))))
+
+(assert (= (prefix_dtmn zeroF) (Zero true)))
+
+(assert (= (to_real1 zeroF) 0.0))
+(assert (= (to_real1 (Zero true)) 0.0))
+
+;; eq_zero
+(assert (infix_dteq zeroF (prefix_dtmn zeroF)))
+
+;; eq_special
+(assert
+ (forall ((x t) (y t))
+ (=>
+ (infix_dteq x y)
+ (or
+ (and (is_finite x) (is_finite y))
+ (and (not (is_finite x)) (and (not (is_finite y)) (same_sign x y)))))))
+
+(assert (=>
+ (and (is_finite zeroF) (and (is_finite (prefix_dtmn zeroF)) (same_sign zeroF (prefix_dtmn zeroF))))
+ (infix_gteqdt (infix_asdt (to_real1 zeroF) (to_real1 (prefix_dtmn zeroF))) 0.0)))
+
+
+(assert (infix_gteqdt (infix_asdt (to_real1 zeroF) (to_real1 (prefix_dtmn zeroF))) 0.0))
+
+;; Goal div_finite_rev
+;; File "/home/bobot/Sources/colibrics/src_common/float_interval.mlw", line 584, characters 8-22
+(assert
+ (not
+ (=>
+ true
+ (not (is_zero zeroF))
+ )))
+
+(check-sat)
diff --git a/src_colibri2/tests/solve/all/unsat/dune.inc b/src_colibri2/tests/solve/all/unsat/dune.inc
index 6c5b832443db80c72eda273714c2b89398a73d65..c84d1e6c69c7da71aedaf78081961e9597199d2f 100644
--- a/src_colibri2/tests/solve/all/unsat/dune.inc
+++ b/src_colibri2/tests/solve/all/unsat/dune.inc
@@ -8,6 +8,9 @@
--dont-print-result %{dep:fact-FactRecursive-fact_recqtvc.psmt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:fact-FactRecursive-fact_recqtvc.psmt2})) (package colibri2))
(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
+--dont-print-result %{dep:float_interval-GenericFloat-add_special_1.psmt2})) (package colibri2))
+(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:float_interval-GenericFloat-add_special_1.psmt2})) (package colibri2))
+(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
--dont-print-result %{dep:interval-Convexe-exists_memqtvc_1.psmt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:interval-Convexe-exists_memqtvc_1.psmt2})) (package colibri2))
(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
@@ -23,6 +26,12 @@
--dont-print-result %{dep:ordered_is_ordered.psmt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:ordered_is_ordered.psmt2})) (package colibri2))
(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
+--dont-print-result %{dep:range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a.psmt2})) (package colibri2))
+(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a.psmt2})) (package colibri2))
+(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
+--dont-print-result %{dep:range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a_simplified.psmt2})) (package colibri2))
+(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a_simplified.psmt2})) (package colibri2))
+(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
--dont-print-result %{dep:union-Union-interqtvc_10.psmt2})) (package colibri2))
(rule (alias runtest-learning) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat --learning --dont-print-result %{dep:union-Union-interqtvc_10.psmt2})) (package colibri2))
(rule (alias runtest) (action (run %{bin:colibri2} --size=50M --time=60s --max-steps 3500 --check-status unsat
diff --git a/src_colibri2/tests/solve/all/unsat/float_interval-GenericFloat-add_special_1.psmt2 b/src_colibri2/tests/solve/all/unsat/float_interval-GenericFloat-add_special_1.psmt2
new file mode 100644
index 0000000000000000000000000000000000000000..ee94fbbadfa27f1aefbf3d7e6f05cec390e9befc
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unsat/float_interval-GenericFloat-add_special_1.psmt2
@@ -0,0 +1,1582 @@
+;; produced by local colibri2.drv ;;
+(set-logic ALL)
+(set-info :smt-lib-version 2.6)
+(set-option :max-steps-colibri2 8000)
+;;; SMT-LIB2: integer arithmetic
+;;; SMT-LIB2: real arithmetic
+(declare-sort string 0)
+
+(declare-datatypes ((tuple0 0))
+ (((Tuple0))))
+
+;; pow2
+(declare-fun pow2 (Int) Int)
+
+;; Power_0
+(assert (= (pow2 0) 1))
+
+;; Power_s
+(assert (forall ((n Int)) (=> (>= n 0) (= (pow2 (+ n 1)) (* 2 (pow2 n))))))
+
+;; Power_1
+(assert (= (pow2 1) 2))
+
+;; Power_sum
+(assert
+ (forall ((n Int) (m Int))
+ (=> (and (>= n 0) (>= m 0)) (= (pow2 (+ n m)) (* (pow2 n) (pow2 m))))))
+
+;; pow2pos
+(assert (forall ((i Int)) (=> (>= i 0) (> (pow2 i) 0))))
+
+;; pow2_0
+(assert (= (pow2 0) 1))
+
+;; pow2_1
+(assert (= (pow2 1) 2))
+
+;; pow2_2
+(assert (= (pow2 2) 4))
+
+;; pow2_3
+(assert (= (pow2 3) 8))
+
+;; pow2_4
+(assert (= (pow2 4) 16))
+
+;; pow2_5
+(assert (= (pow2 5) 32))
+
+;; pow2_6
+(assert (= (pow2 6) 64))
+
+;; pow2_7
+(assert (= (pow2 7) 128))
+
+;; pow2_8
+(assert (= (pow2 8) 256))
+
+;; pow2_9
+(assert (= (pow2 9) 512))
+
+;; pow2_10
+(assert (= (pow2 10) 1024))
+
+;; pow2_11
+(assert (= (pow2 11) 2048))
+
+;; pow2_12
+(assert (= (pow2 12) 4096))
+
+;; pow2_13
+(assert (= (pow2 13) 8192))
+
+;; pow2_14
+(assert (= (pow2 14) 16384))
+
+;; pow2_15
+(assert (= (pow2 15) 32768))
+
+;; pow2_16
+(assert (= (pow2 16) 65536))
+
+;; pow2_17
+(assert (= (pow2 17) 131072))
+
+;; pow2_18
+(assert (= (pow2 18) 262144))
+
+;; pow2_19
+(assert (= (pow2 19) 524288))
+
+;; pow2_20
+(assert (= (pow2 20) 1048576))
+
+;; pow2_21
+(assert (= (pow2 21) 2097152))
+
+;; pow2_22
+(assert (= (pow2 22) 4194304))
+
+;; pow2_23
+(assert (= (pow2 23) 8388608))
+
+;; pow2_24
+(assert (= (pow2 24) 16777216))
+
+;; pow2_25
+(assert (= (pow2 25) 33554432))
+
+;; pow2_26
+(assert (= (pow2 26) 67108864))
+
+;; pow2_27
+(assert (= (pow2 27) 134217728))
+
+;; pow2_28
+(assert (= (pow2 28) 268435456))
+
+;; pow2_29
+(assert (= (pow2 29) 536870912))
+
+;; pow2_30
+(assert (= (pow2 30) 1073741824))
+
+;; pow2_31
+(assert (= (pow2 31) 2147483648))
+
+;; pow2_32
+(assert (= (pow2 32) 4294967296))
+
+;; pow2_33
+(assert (= (pow2 33) 8589934592))
+
+;; pow2_34
+(assert (= (pow2 34) 17179869184))
+
+;; pow2_35
+(assert (= (pow2 35) 34359738368))
+
+;; pow2_36
+(assert (= (pow2 36) 68719476736))
+
+;; pow2_37
+(assert (= (pow2 37) 137438953472))
+
+;; pow2_38
+(assert (= (pow2 38) 274877906944))
+
+;; pow2_39
+(assert (= (pow2 39) 549755813888))
+
+;; pow2_40
+(assert (= (pow2 40) 1099511627776))
+
+;; pow2_41
+(assert (= (pow2 41) 2199023255552))
+
+;; pow2_42
+(assert (= (pow2 42) 4398046511104))
+
+;; pow2_43
+(assert (= (pow2 43) 8796093022208))
+
+;; pow2_44
+(assert (= (pow2 44) 17592186044416))
+
+;; pow2_45
+(assert (= (pow2 45) 35184372088832))
+
+;; pow2_46
+(assert (= (pow2 46) 70368744177664))
+
+;; pow2_47
+(assert (= (pow2 47) 140737488355328))
+
+;; pow2_48
+(assert (= (pow2 48) 281474976710656))
+
+;; pow2_49
+(assert (= (pow2 49) 562949953421312))
+
+;; pow2_50
+(assert (= (pow2 50) 1125899906842624))
+
+;; pow2_51
+(assert (= (pow2 51) 2251799813685248))
+
+;; pow2_52
+(assert (= (pow2 52) 4503599627370496))
+
+;; pow2_53
+(assert (= (pow2 53) 9007199254740992))
+
+;; pow2_54
+(assert (= (pow2 54) 18014398509481984))
+
+;; pow2_55
+(assert (= (pow2 55) 36028797018963968))
+
+;; pow2_56
+(assert (= (pow2 56) 72057594037927936))
+
+;; pow2_57
+(assert (= (pow2 57) 144115188075855872))
+
+;; pow2_58
+(assert (= (pow2 58) 288230376151711744))
+
+;; pow2_59
+(assert (= (pow2 59) 576460752303423488))
+
+;; pow2_60
+(assert (= (pow2 60) 1152921504606846976))
+
+;; pow2_61
+(assert (= (pow2 61) 2305843009213693952))
+
+;; pow2_62
+(assert (= (pow2 62) 4611686018427387904))
+
+;; pow2_63
+(assert (= (pow2 63) 9223372036854775808))
+
+;; pow2_64
+(assert (= (pow2 64) 18446744073709551616))
+
+;; add_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (+ x y) z) (+ (/ x z) (/ y z))))))
+
+;; sub_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (- x y) z) (- (/ x z) (/ y z))))))
+
+;; neg_div
+(assert
+ (forall ((x Real) (y Real))
+ (=> (not (= y 0.0)) (= (/ (- x) y) (- (/ x y))))))
+
+;; assoc_mul_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (* x y) z) (* x (/ y z))))))
+
+;; assoc_div_mul
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=>
+ (and (not (= y 0.0)) (not (= z 0.0)))
+ (= (/ (/ x y) z) (/ x (* y z))))))
+
+;; assoc_div_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=>
+ (and (not (= y 0.0)) (not (= z 0.0)))
+ (= (/ x (/ y z)) (/ (* x z) y)))))
+
+;; abs
+(define-fun abs1 ((x Real)) Real
+ (ite (>= x 0.0) x (- x)))
+
+;; Abs_le
+(assert
+ (forall ((x Real) (y Real))
+ (= (<= (abs1 x) y) (and (<= (- y) x) (<= x y)))))
+
+;; Abs_pos
+(assert (forall ((x Real)) (>= (abs1 x) 0.0)))
+
+;; Abs_sum
+(assert
+ (forall ((x Real) (y Real)) (<= (abs1 (+ x y)) (+ (abs1 x) (abs1 y)))))
+
+;; Abs_prod
+(assert
+ (forall ((x Real) (y Real)) (= (abs1 (* x y)) (* (abs1 x) (abs1 y)))))
+
+;; triangular_inequality
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (<= (abs1 (- x z)) (+ (abs1 (- x y)) (abs1 (- y z))))))
+
+;; Zero
+(assert (= (to_real 0) 0.0))
+
+;; One
+(assert (= (to_real 1) 1.0))
+
+;; Add
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (+ x y)) (+ (to_real x) (to_real y)))))
+
+;; Sub
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (- x y)) (- (to_real x) (to_real y)))))
+
+;; Mul
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (* x y)) (* (to_real x) (to_real y)))))
+
+;; Neg
+(assert (forall ((x Int)) (= (to_real (- x)) (- (to_real x)))))
+
+;; Injective
+(assert (forall ((x Int) (y Int)) (=> (= (to_real x) (to_real y)) (= x y))))
+
+;; Monotonic
+(assert
+ (forall ((x Int) (y Int)) (=> (<= x y) (<= (to_real x) (to_real y)))))
+
+;; truncate
+(declare-fun truncate (Real) Int)
+
+;; Truncate_int
+(assert (forall ((i Int)) (= (truncate (to_real i)) i)))
+
+;; Truncate_down_pos
+(assert
+ (forall ((x Real))
+ (=>
+ (>= x 0.0)
+ (and (<= (to_real (truncate x)) x) (< x (to_real (+ (truncate x) 1)))))))
+
+;; Truncate_up_neg
+(assert
+ (forall ((x Real))
+ (=>
+ (<= x 0.0)
+ (and (< (to_real (- (truncate x) 1)) x) (<= x (to_real (truncate x)))))))
+
+;; Real_of_truncate
+(assert
+ (forall ((x Real))
+ (and
+ (<= (- x 1.0) (to_real (truncate x)))
+ (<= (to_real (truncate x)) (+ x 1.0)))))
+
+;; Truncate_monotonic
+;;(assert
+;; (forall ((x Real) (y Real)) (=> (<= x y) (<= (truncate x) (truncate y)))))
+
+;; Truncate_monotonic_int1
+(assert
+ (forall ((x Real) (i Int)) (=> (<= x (to_real i)) (<= (truncate x) i))))
+
+;; Truncate_monotonic_int2
+(assert
+ (forall ((x Real) (i Int)) (=> (<= (to_real i) x) (<= i (truncate x)))))
+
+;;Floor_int
+(assert (forall ((i Int)) (= (to_int (to_real i)) i)))
+
+;;Ceil_int
+(assert (forall ((i Int)) (= (- (to_int (- (to_real i)))) i)))
+
+;; Floor_down
+(assert
+ (forall ((x Real))
+ (and (<= (to_real (to_int x)) x) (< x (to_real (+ (to_int x) 1))))))
+
+;; Ceil_up
+(assert
+ (forall ((x Real))
+ (and
+ (< (to_real (- (- (to_int (- x))) 1)) x)
+ (<= x (to_real (- (to_int (- x))))))))
+
+;; Floor_monotonic
+(assert
+ (forall ((x Real) (y Real)) (=> (<= x y) (<= (to_int x) (to_int y)))))
+
+;; Ceil_monotonic
+(assert
+ (forall ((x Real) (y Real))
+ (=> (<= x y) (<= (- (to_int (- x))) (- (to_int (- y)))))))
+
+;; infix +.
+(define-fun infix_pldt ((x Real) (y Real)) Real
+ (+ x y))
+
+;; infix -.
+(define-fun infix_mndt ((x Real) (y Real)) Real
+ (- x y))
+
+;; infix *.
+(define-fun infix_asdt ((x Real) (y Real)) Real
+ (* x y))
+
+;; infix /.
+(define-fun infix_sldt ((x Real) (y Real)) Real
+ (/ x y))
+
+;; prefix -.
+(define-fun prefix_mndt ((x Real)) Real
+ (- x))
+
+;; inv
+(define-fun inv ((x Real)) Real
+ (/ 1.0 x))
+
+;; infix <=.
+(define-fun infix_lseqdt ((x Real) (y Real)) Bool
+ (<= x y))
+
+;; infix >=.
+(define-fun infix_gteqdt ((x Real) (y Real)) Bool
+ (>= x y))
+
+;; infix <.
+(define-fun infix_lsdt ((x Real) (y Real)) Bool
+ (< x y))
+
+;; infix >.
+(define-fun infix_gtdt ((x Real) (y Real)) Bool
+ (> x y))
+
+(declare-datatypes ((mode 0))
+ (((RNE1) (RNA1) (RTP1) (RTN1) (RTZ1))))
+
+;; to_nearest
+(define-fun to_nearest ((m mode)) Bool
+ (or (= m RNE1) (= m RNA1)))
+
+;; eb
+(declare-fun eb () Int)
+
+;; sb
+(declare-fun sb () Int)
+
+;; eb_gt_1
+(assert (< 1 eb))
+
+;; sb_gt_1
+(assert (< 1 sb))
+
+;; max_real
+(declare-fun max_real () Real)
+
+;; in_range
+(define-fun in_range ((x Real)) Bool
+ (and (infix_lseqdt (prefix_mndt max_real) x) (infix_lseqdt x max_real)))
+
+(declare-sort finite 0)
+
+;; r
+(declare-fun r (finite) Real)
+
+;; finite'invariant
+(assert
+ (forall ((self finite))
+ (! (and (in_range (r self)) (not (= (r self) 0.0))) :pattern ((r self)) )))
+
+;; mk_finite
+(declare-fun mk_finite (Real) finite)
+
+;; mk_finite_def
+(assert
+ (forall ((rr Real))
+ (! (=> (in_range rr) (=> (not (= rr 0.0)) (= (r (mk_finite rr)) rr))) :pattern (
+ (mk_finite
+ rr)) )))
+
+(declare-datatypes ((t 0))
+ (((Zero (Zero_proj_1 Bool)) (Infinity (Infinity_proj_1 Bool)) (NaN1)
+ (Finite (Finite_proj_1 finite)))))
+
+;; zeroF
+(declare-fun zeroF () t)
+
+;; sub
+(declare-fun sub (mode
+ t
+ t) t)
+
+;; mul
+(declare-fun mul (mode
+ t
+ t) t)
+
+;; div
+(declare-fun div1 (mode
+ t
+ t) t)
+
+;; abs
+(declare-fun abs2 (t) t)
+
+;; neg
+(declare-fun neg (t) t)
+
+;; fma
+(declare-fun fma (mode
+ t
+ t
+ t) t)
+
+;; sqrt
+(declare-fun sqrt1 (mode
+ t) t)
+
+;; prefix .-
+(define-fun prefix_dtmn ((x t)) t
+ (neg x))
+
+;; infix .-
+(define-fun infix_dtmn ((x t) (y t)) t
+ (sub RNE1 x y))
+
+;; infix .*
+(define-fun infix_dtas ((x t) (y t)) t
+ (mul RNE1 x y))
+
+;; infix ./
+(define-fun infix_dtsl ((x t) (y t)) t
+ (div1 RNE1 x y))
+
+;; roundToIntegral
+(declare-fun roundToIntegral (mode
+ t) t)
+
+;; min
+(declare-fun min (t
+ t) t)
+
+;; max
+(declare-fun max (t
+ t) t)
+
+;; sign
+(define-fun sign ((r1 Real)) Bool
+ (infix_lsdt r1 0.0))
+
+;; to_real
+(define-fun to_real1 ((x t)) Real
+ (ite ((_ is NaN1) x) (infix_pldt max_real 1.0) (ite ((_ is Infinity) x)
+ (let ((x1 (Infinity_proj_1 x)))
+ (ite (= x1 true)
+ (infix_mndt
+ (prefix_mndt
+ max_real)
+ 1.0)
+ (infix_pldt
+ max_real
+ 1.0))) (ite ((_ is Zero) x) 0.0
+ (let ((x2 (Finite_proj_1 x)))
+ (r
+ x2))))))
+
+;; is_positive
+(define-fun is_positive ((f t)) Bool
+ (ite ((_ is NaN1) f) false (ite ((_ is Zero) f) (let ((neg1 (Zero_proj_1 f))) (= (not neg1) true))
+ (ite ((_ is Finite) f) (let ((r1 (Finite_proj_1 f)))
+ (infix_lseqdt
+ 0.0
+ (r r1))) (let ((neg2 (Infinity_proj_1 f))) (= (not neg2) true))))))
+
+;; is_negative
+(define-fun is_negative ((f t)) Bool
+ (ite ((_ is NaN1) f) false (ite ((_ is Zero) f) (let ((neg3 (Zero_proj_1 f))) (= neg3 true))
+ (ite ((_ is Finite) f) (let ((r2 (Finite_proj_1 f)))
+ (infix_lseqdt
+ (r r2)
+ 0.0)) (let ((neg4 (Infinity_proj_1 f))) (= neg4 true))))))
+
+(declare-datatypes ((classify 0))
+ (((Is_normal) (Is_subnormal) (Is_zero) (Is_infinite) (Is_nan))))
+
+;; first_normal
+(declare-fun first_normal () Real)
+
+;; classify
+(define-fun classify1 ((f t)) classify
+ (ite ((_ is Finite) f) (let ((x (Finite_proj_1 f))) (ite (and
+ (infix_lsdt
+ (prefix_mndt
+ first_normal)
+ (r x))
+ (infix_lsdt
+ (r x)
+ first_normal))
+ Is_subnormal
+ Is_normal)) (ite ((_ is Zero) f)
+ Is_zero
+ (ite ((_ is Infinity) f)
+ Is_infinite
+ Is_nan))))
+
+(declare-datatypes ((tuple2 2))
+ ((par (a a1) ((Tuple2 (Tuple2_proj_1 a)(Tuple2_proj_2 a1))))))
+
+;; le
+(define-fun le ((f1 t) (f2 t)) Bool
+ (ite ((_ is NaN1) f2) (ite ((_ is NaN1) f1) false (ite ((_ is Infinity) f1) false false))
+ (ite ((_ is Zero) f2) (ite ((_ is NaN1) f1) false (ite ((_ is Zero) f1) true
+ (ite ((_ is Finite) f1)
+ (let ((x3 (Finite_proj_1 f1)))
+ (infix_lseqdt
+ (r x3)
+ 0.0)) (let ((x4 (Infinity_proj_1 f1))) (= x4 true)))))
+ (ite ((_ is Finite) f2) (let ((x5 (Finite_proj_1 f2))) (ite ((_ is NaN1) f1) false
+ (ite ((_ is Zero) f1)
+ (infix_lseqdt
+ 0.0
+ (r x5))
+ (ite ((_ is Finite) f1)
+ (let ((x6 (Finite_proj_1 f1)))
+ (infix_lseqdt
+ (r x6)
+ (r x5)))
+ (let ((x7 (Infinity_proj_1 f1))) (= x7 true))))))
+ (let ((x8 (Infinity_proj_1 f2))) (ite ((_ is NaN1) f1) false
+ (ite ((_ is Infinity) f1)
+ (let ((x9 (Infinity_proj_1 f1))) (= (or x9 (not x8)) true)) (= (not x8) true))))))))
+
+;; lt
+(declare-fun lt (t
+ t) Bool)
+
+;; ge
+(define-fun ge ((x10 t) (y t)) Bool
+ (le y x10))
+
+;; gt
+(define-fun gt ((x10 t) (y t)) Bool
+ (lt y x10))
+
+;; eq
+(declare-fun eq (t
+ t) Bool)
+
+;; infix .<=
+(define-fun infix_dtlseq ((x10 t) (y t)) Bool
+ (le x10 y))
+
+;; infix .<
+(define-fun infix_dtls ((x10 t) (y t)) Bool
+ (lt x10 y))
+
+;; infix .>=
+(define-fun infix_dtgteq ((x10 t) (y t)) Bool
+ (ge x10 y))
+
+;; infix .>
+(define-fun infix_dtgt ((x10 t) (y t)) Bool
+ (gt x10 y))
+
+;; infix .=
+(define-fun infix_dteq ((x10 t) (y t)) Bool
+ (eq x10 y))
+
+;; is_normal
+(define-fun is_normal ((f t)) Bool
+ (= (classify1 f) Is_normal))
+
+;; is_subnormal
+(define-fun is_subnormal ((f t)) Bool
+ (= (classify1 f) Is_subnormal))
+
+;; is_zero
+(define-fun is_zero ((f t)) Bool
+ (ite ((_ is Zero) f) true false))
+
+;; is_infinite
+(define-fun is_infinite ((f t)) Bool
+ (ite ((_ is Infinity) f) true false))
+
+;; is_nan
+(define-fun is_nan ((f t)) Bool
+ (ite ((_ is NaN1) f) true false))
+
+;; is_finite
+(define-fun is_finite ((f t)) Bool
+ (ite ((_ is Zero) f) true (ite ((_ is Finite) f) true (ite ((_ is Infinity) f) false false))))
+
+;; is_plus_infinity
+(define-fun is_plus_infinity ((x10 t)) Bool
+ (ite ((_ is Infinity) x10) (let ((neg5 (Infinity_proj_1 x10))) (= (not neg5) true)) false))
+
+;; is_minus_infinity
+(define-fun is_minus_infinity ((x10 t)) Bool
+ (ite ((_ is Infinity) x10) (let ((neg6 (Infinity_proj_1 x10))) (= neg6 true)) false))
+
+;; is_plus_zero
+(define-fun is_plus_zero ((x10 t)) Bool
+ (ite ((_ is Zero) x10) (let ((neg7 (Zero_proj_1 x10))) (= (not neg7) true)) false))
+
+;; is_minus_zero
+(define-fun is_minus_zero ((x10 t)) Bool
+ (ite ((_ is Zero) x10) (let ((neg8 (Zero_proj_1 x10))) (= neg8 true)) false))
+
+;; is_not_nan
+(define-fun is_not_nan ((x10 t)) Bool
+ (ite ((_ is NaN1) x10) false true))
+
+;; is_not_nan
+(assert (forall ((x10 t)) (= (is_not_nan x10) (not (is_nan x10)))))
+
+;; is_not_finite
+(assert
+ (forall ((x10 t))
+ (= (not (is_finite x10)) (or (is_infinite x10) (is_nan x10)))))
+
+;; zeroF_is_positive
+(assert (is_positive zeroF))
+
+;; zeroF_is_zero
+(assert (is_zero zeroF))
+
+;; zero_to_real
+(assert
+ (forall ((x10 t))
+ (! (= (is_zero x10) (and (is_finite x10) (= (to_real1 x10) 0.0))) :pattern (
+ (is_zero
+ x10)) )))
+
+;; of_int
+(declare-fun of_int (mode
+ Int) t)
+
+;; to_int
+(declare-fun to_int1 (mode
+ t) Int)
+
+;; zero_of_int
+(assert (forall ((m mode)) (= zeroF (of_int m 0))))
+
+;; round
+(declare-fun round (mode
+ Real) Real)
+
+;; max_int
+(declare-fun max_int () Int)
+
+;; emax
+(define-fun emax () Int
+ (pow2 (- eb 1)))
+
+;; max_real_bound
+(assert (infix_lsdt 0.0 max_real))
+
+;; max_int_bound
+(assert (< 0 max_int))
+
+;; max_int
+(assert (= max_int (- (pow2 emax) (pow2 (- emax sb)))))
+
+;; max_real_int
+(assert (= max_real (to_real max_int)))
+
+;; in_int_range
+(define-fun in_int_range ((i Int)) Bool
+ (and (<= (- max_int) i) (<= i max_int)))
+
+;; max_real_round
+(assert (forall ((m mode)) (= (round m max_real) max_real)))
+
+;; minus_max_real_round
+(assert
+ (forall ((m mode))
+ (= (round m (prefix_mndt max_real)) (prefix_mndt max_real))))
+
+;; is_finite
+(assert (forall ((x10 t)) (=> (is_finite x10) (in_range (to_real1 x10)))))
+
+;; no_overflow
+(define-fun no_overflow ((m mode) (x10 Real)) Bool
+ (in_range (round m x10)))
+
+;; Bounded_real_no_overflow
+(assert
+ (forall ((m mode) (x10 Real)) (=> (in_range x10) (no_overflow m x10))))
+
+;; Round_monotonic
+(assert
+ (forall ((m mode) (x10 Real) (y Real))
+ (=> (infix_lseqdt x10 y) (infix_lseqdt (round m x10) (round m y)))))
+
+;; Round_idempotent
+(assert
+ (forall ((m1 mode) (m2 mode) (x10 Real))
+ (= (round m1 (round m2 x10)) (round m2 x10))))
+
+;; Round_to_real
+(assert
+ (forall ((m mode) (x10 t))
+ (=> (is_finite x10) (= (round m (to_real1 x10)) (to_real1 x10)))))
+
+;; Round_down_le
+(assert (forall ((x10 Real)) (infix_lseqdt (round RTN1 x10) x10)))
+
+;; Round_up_ge
+(assert (forall ((x10 Real)) (infix_gteqdt (round RTP1 x10) x10)))
+
+;; Round_down_neg
+(assert
+ (forall ((x10 Real))
+ (= (round RTN1 (prefix_mndt x10)) (prefix_mndt (round RTP1 x10)))))
+
+;; Round_up_neg
+(assert
+ (forall ((x10 Real))
+ (= (round RTP1 (prefix_mndt x10)) (prefix_mndt (round RTN1 x10)))))
+
+;; pow2sb
+(declare-fun pow2sb () Int)
+
+;; pow2sb
+(assert (= pow2sb (pow2 sb)))
+
+;; in_safe_int_range
+(define-fun in_safe_int_range ((i Int)) Bool
+ (and (<= (- pow2sb) i) (<= i pow2sb)))
+
+;; Exact_rounding_for_integers
+(assert
+ (forall ((m mode) (i Int))
+ (=> (in_safe_int_range i) (= (round m (to_real i)) (to_real i)))))
+
+;; same_sign
+(define-fun same_sign ((x10 t) (y t)) Bool
+ (or
+ (and (is_positive x10) (is_positive y))
+ (and (is_negative x10) (is_negative y))))
+
+;; diff_sign
+(define-fun diff_sign ((x10 t) (y t)) Bool
+ (or
+ (and (is_positive x10) (is_negative y))
+ (and (is_negative x10) (is_positive y))))
+
+;; feq_eq
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (is_finite x10)
+ (=>
+ (is_finite y)
+ (=> (not (is_zero x10)) (=> (infix_dteq x10 y) (= x10 y)))))))
+
+;; eq_feq
+(assert
+ (forall ((x10 t))
+ (=> (is_finite x10) (=> (is_finite x10) (infix_dteq x10 x10)))))
+
+;; eq_refl
+(assert (forall ((x10 t)) (=> (is_finite x10) (infix_dteq x10 x10))))
+
+;; eq_sym
+(assert (forall ((x10 t) (y t)) (=> (infix_dteq x10 y) (infix_dteq y x10))))
+
+;; eq_trans
+(assert
+ (forall ((x10 t) (y t) (z t))
+ (=> (infix_dteq x10 y) (=> (infix_dteq y z) (infix_dteq x10 z)))))
+
+;; eq_zero
+(assert (infix_dteq zeroF (prefix_dtmn zeroF)))
+
+;; eq_to_real_finite
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (and (is_finite x10) (is_finite y))
+ (= (infix_dteq x10 y) (= (to_real1 x10) (to_real1 y))))))
+
+;; eq_special
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (infix_dteq x10 y)
+ (and
+ (is_not_nan x10)
+ (and
+ (is_not_nan y)
+ (or
+ (and (is_finite x10) (is_finite y))
+ (and (is_infinite x10) (and (is_infinite y) (same_sign x10 y)))))))))
+
+;; lt_finite
+(assert
+ (forall ((x10 t) (y t))
+ (! (=>
+ (and (is_finite x10) (is_finite y))
+ (= (lt x10 y) (infix_lsdt (to_real1 x10) (to_real1 y)))) :pattern (
+ (lt
+ x10
+ y)) )))
+
+;; le_finite
+(assert
+ (forall ((x10 t) (y t))
+ (! (=>
+ (and (is_finite x10) (is_finite y))
+ (= (le x10 y) (infix_lseqdt (to_real1 x10) (to_real1 y)))) :pattern (
+ (le
+ x10
+ y)) )))
+
+;; le_lt_trans
+(assert
+ (forall ((x10 t) (y t) (z t))
+ (=> (and (infix_dtlseq x10 y) (infix_dtls y z)) (infix_dtls x10 z))))
+
+;; lt_le_trans
+(assert
+ (forall ((x10 t) (y t) (z t))
+ (=> (and (infix_dtls x10 y) (infix_dtlseq y z)) (infix_dtls x10 z))))
+
+;; le_ge_asym
+(assert
+ (forall ((x10 t) (y t))
+ (=> (and (infix_dtlseq x10 y) (infix_dtgteq x10 y)) (infix_dteq x10 y))))
+
+;; not_lt_ge
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (and (not (infix_dtls x10 y)) (and (is_not_nan x10) (is_not_nan y)))
+ (infix_dtgteq x10 y))))
+
+;; not_gt_le
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (and (not (infix_dtgt x10 y)) (and (is_not_nan x10) (is_not_nan y)))
+ (infix_dtlseq x10 y))))
+
+;; le_special
+(assert
+ (forall ((x10 t) (y t))
+ (! (=>
+ (le x10 y)
+ (or
+ (and (is_finite x10) (is_finite y))
+ (or
+ (and (is_minus_infinity x10) (is_not_nan y))
+ (and (is_not_nan x10) (is_plus_infinity y))))) :pattern (
+ (le
+ x10
+ y)) )))
+
+;; lt_special
+(assert
+ (forall ((x10 t) (y t))
+ (! (=>
+ (lt x10 y)
+ (or
+ (and (is_finite x10) (is_finite y))
+ (or
+ (and
+ (is_minus_infinity x10)
+ (and (is_not_nan y) (not (is_minus_infinity y))))
+ (and
+ (is_not_nan x10)
+ (and (not (is_plus_infinity x10)) (is_plus_infinity y)))))) :pattern (
+ (lt
+ x10
+ y)) )))
+
+;; lt_lt_finite
+(assert
+ (forall ((x10 t) (y t) (z t)) (=> (lt x10 y) (=> (lt y z) (is_finite y)))))
+
+;; positive_to_real
+(assert
+ (forall ((x10 t))
+ (! (=>
+ (is_finite x10)
+ (=> (is_positive x10) (infix_gteqdt (to_real1 x10) 0.0))) :pattern (
+ (is_positive
+ x10)) :pattern ((infix_gteqdt (to_real1 x10) 0.0)) )))
+
+;; to_real_positive
+(assert
+ (forall ((x10 t))
+ (! (=>
+ (is_finite x10)
+ (=> (infix_gtdt (to_real1 x10) 0.0) (is_positive x10))) :pattern (
+ (is_positive
+ x10)) )))
+
+;; negative_to_real
+(assert
+ (forall ((x10 t))
+ (! (=>
+ (is_finite x10)
+ (=> (is_negative x10) (infix_lseqdt (to_real1 x10) 0.0))) :pattern (
+ (is_negative
+ x10)) :pattern ((infix_lseqdt (to_real1 x10) 0.0)) )))
+
+;; to_real_negative
+(assert
+ (forall ((x10 t))
+ (! (=>
+ (is_finite x10)
+ (=> (infix_lsdt (to_real1 x10) 0.0) (is_negative x10))) :pattern (
+ (is_negative
+ x10)) )))
+
+;; negative_xor_positive
+(assert (forall ((x10 t)) (not (and (is_positive x10) (is_negative x10)))))
+
+;; negative_or_positive
+(assert
+ (forall ((x10 t))
+ (=> (is_not_nan x10) (or (is_positive x10) (is_negative x10)))))
+
+;; diff_sign_trans
+(assert
+ (forall ((x10 t) (y t) (z t))
+ (=> (and (diff_sign x10 y) (diff_sign y z)) (same_sign x10 z))))
+
+;; diff_sign_product
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (and
+ (is_finite x10)
+ (and
+ (is_finite y)
+ (infix_lsdt (infix_asdt (to_real1 x10) (to_real1 y)) 0.0)))
+ (diff_sign x10 y))))
+
+;; same_sign_product
+(assert
+ (forall ((x10 t) (y t))
+ (=>
+ (and (is_finite x10) (and (is_finite y) (same_sign x10 y)))
+ (infix_gteqdt (infix_asdt (to_real1 x10) (to_real1 y)) 0.0))))
+
+;; product_sign
+(define-fun product_sign ((z t) (x10 t) (y t)) Bool
+ (and
+ (=> (same_sign x10 y) (is_positive z))
+ (=> (diff_sign x10 y) (is_negative z))))
+
+;; overflow_value
+(define-fun overflow_value ((m mode) (x10 t)) Bool
+ (ite ((_ is RTN1) m) (ite (is_positive x10)
+ (and (is_finite x10) (= (to_real1 x10) max_real))
+ (is_infinite x10)) (ite ((_ is RTP1) m) (ite
+ (is_positive
+ x10)
+ (is_infinite
+ x10)
+ (and
+ (is_finite
+ x10)
+ (=
+ (to_real1
+ x10)
+ (prefix_mndt
+ max_real))))
+ (ite ((_ is RTZ1) m) (ite
+ (is_positive
+ x10)
+ (and
+ (is_finite
+ x10)
+ (=
+ (to_real1
+ x10)
+ max_real))
+ (and
+ (is_finite
+ x10)
+ (=
+ (to_real1
+ x10)
+ (prefix_mndt
+ max_real))))
+ (ite ((_ is RNA1) m)
+ (is_infinite
+ x10) (is_infinite x10))))))
+
+;; sign_zero_result
+(define-fun sign_zero_result ((m mode) (x10 t)) Bool
+ (=>
+ (is_zero x10)
+ (ite ((_ is RTN1) m) (is_negative x10) (is_positive x10))))
+
+;; is_RTN
+(define-fun is_RTN ((mode1 mode)) Bool
+ (ite ((_ is RTN1) mode1) true false))
+
+;; add
+(define-fun add ((mode1 mode) (x10 t) (y t)) t
+ (ite ((_ is NaN1) y) (ite ((_ is NaN1) x10) NaN1 (ite ((_ is Zero) x10)
+ NaN1 (ite ((_ is Infinity) x10)
+ NaN1 NaN1)))
+ (ite ((_ is Zero) y) (let ((x11 (Zero_proj_1 y))) (ite ((_ is NaN1) x10)
+ NaN1 (ite ((_ is Zero) x10)
+ (let ((x12 (Zero_proj_1 x10)))
+ (ite (= x12 x11)
+ (Zero x12)
+ (Zero
+ (is_RTN
+ mode1))))
+ (ite ((_ is Infinity) x10) x10 x10))))
+ (ite ((_ is Infinity) y) (let ((x13 (Infinity_proj_1 y))) (ite ((_ is NaN1) x10)
+ NaN1
+ (ite ((_ is Zero) x10) y
+ (ite ((_ is Infinity) x10)
+ (let ((x14 (Infinity_proj_1 x10)))
+ (ite (= x14 x13)
+ x10
+ NaN1)) y))))
+ (let ((x15 (Finite_proj_1 y))) (ite ((_ is NaN1) x10) NaN1 (ite ((_ is Zero) x10) y
+ (ite ((_ is Infinity) x10) x10
+ (let ((x16 (Finite_proj_1 x10)))
+ (let ((r3
+ (round
+ mode1
+ (infix_pldt
+ (r x16)
+ (r x15)))))
+ (ite (= r3 0.0)
+ (Zero
+ (is_RTN
+ mode1))
+ (ite
+ (in_range
+ r3)
+ (Finite
+ (mk_finite
+ r3))
+ (ite ((_ is RTN1) mode1)
+ (ite
+ (sign
+ r3)
+ (Infinity
+ true)
+ (Finite
+ (mk_finite
+ max_real)))
+ (ite ((_ is RTP1) mode1)
+ (ite
+ (sign
+ r3)
+ (Finite
+ (mk_finite
+ (prefix_mndt
+ max_real)))
+ (Infinity
+ false))
+ (ite ((_ is RTZ1) mode1)
+ (ite
+ (sign
+ r3)
+ (Finite
+ (mk_finite
+ (prefix_mndt
+ max_real)))
+ (Finite
+ (mk_finite
+ max_real)))
+ (ite ((_ is RNA1) mode1)
+ (Infinity
+ (ite
+ (sign
+ r3)
+ true
+ false))
+ (Infinity
+ (ite
+ (sign
+ r3)
+ true
+ false))))))))))))))))))
+
+;; infix .+
+(define-fun infix_dtpl ((x17 t) (y t)) t
+ (add RNE1 x17 y))
+
+;; sub_finite
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (is_finite x17)
+ (=>
+ (is_finite y)
+ (=>
+ (no_overflow m (infix_mndt (to_real1 x17) (to_real1 y)))
+ (and
+ (is_finite (sub m x17 y))
+ (= (to_real1 (sub m x17 y)) (round
+ m
+ (infix_mndt
+ (to_real1 x17)
+ (to_real1 y)))))))) :pattern (
+ (sub
+ m
+ x17
+ y)) )))
+
+;; sub_finite_rev
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=> (is_finite (sub m x17 y)) (and (is_finite x17) (is_finite y))) :pattern (
+ (sub
+ m
+ x17
+ y)) )))
+
+;; sub_finite_rev_n
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (to_nearest m)
+ (=>
+ (is_finite (sub m x17 y))
+ (and
+ (no_overflow m (infix_mndt (to_real1 x17) (to_real1 y)))
+ (= (to_real1 (sub m x17 y)) (round
+ m
+ (infix_mndt
+ (to_real1 x17)
+ (to_real1 y))))))) :pattern (
+ (sub
+ m
+ x17
+ y)) )))
+
+;; mul_finite
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (is_finite x17)
+ (=>
+ (is_finite y)
+ (=>
+ (no_overflow m (infix_asdt (to_real1 x17) (to_real1 y)))
+ (and
+ (is_finite (mul m x17 y))
+ (= (to_real1 (mul m x17 y)) (round
+ m
+ (infix_asdt
+ (to_real1 x17)
+ (to_real1 y)))))))) :pattern (
+ (mul
+ m
+ x17
+ y)) )))
+
+;; mul_finite_rev
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=> (is_finite (mul m x17 y)) (and (is_finite x17) (is_finite y))) :pattern (
+ (mul
+ m
+ x17
+ y)) )))
+
+;; mul_finite_rev_n
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (to_nearest m)
+ (=>
+ (is_finite (mul m x17 y))
+ (and
+ (no_overflow m (infix_asdt (to_real1 x17) (to_real1 y)))
+ (= (to_real1 (mul m x17 y)) (round
+ m
+ (infix_asdt
+ (to_real1 x17)
+ (to_real1 y))))))) :pattern (
+ (mul
+ m
+ x17
+ y)) )))
+
+;; div_finite
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (is_finite x17)
+ (=>
+ (is_finite y)
+ (=>
+ (not (is_zero y))
+ (=>
+ (no_overflow m (infix_sldt (to_real1 x17) (to_real1 y)))
+ (and
+ (is_finite (div1 m x17 y))
+ (= (to_real1 (div1 m x17 y)) (round
+ m
+ (infix_sldt
+ (to_real1 x17)
+ (to_real1 y))))))))) :pattern (
+ (div1
+ m
+ x17
+ y)) )))
+
+;; div_finite_rev
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (is_finite (div1 m x17 y))
+ (or
+ (and (is_finite x17) (and (is_finite y) (not (is_zero y))))
+ (and
+ (is_finite x17)
+ (and (is_infinite y) (= (to_real1 (div1 m x17 y)) 0.0))))) :pattern (
+ (div1
+ m
+ x17
+ y)) )))
+
+;; div_finite_rev_n
+(assert
+ (forall ((m mode) (x17 t) (y t))
+ (! (=>
+ (to_nearest m)
+ (=>
+ (is_finite (div1 m x17 y))
+ (=>
+ (is_finite y)
+ (and
+ (no_overflow m (infix_sldt (to_real1 x17) (to_real1 y)))
+ (= (to_real1 (div1 m x17 y)) (round
+ m
+ (infix_sldt
+ (to_real1 x17)
+ (to_real1 y)))))))) :pattern (
+ (div1
+ m
+ x17
+ y)) )))
+
+;; neg_finite
+(assert
+ (forall ((x17 t))
+ (! (=>
+ (is_finite x17)
+ (and
+ (is_finite (neg x17))
+ (= (to_real1 (neg x17)) (prefix_mndt (to_real1 x17))))) :pattern (
+ (neg
+ x17)) )))
+
+;; neg_finite_rev
+(assert
+ (forall ((x17 t))
+ (! (=>
+ (is_finite (neg x17))
+ (and
+ (is_finite x17)
+ (= (to_real1 (neg x17)) (prefix_mndt (to_real1 x17))))) :pattern (
+ (neg
+ x17)) )))
+
+;; abs_finite
+(assert
+ (forall ((x17 t))
+ (! (=>
+ (is_finite x17)
+ (and
+ (is_finite (abs2 x17))
+ (and
+ (= (to_real1 (abs2 x17)) (abs1 (to_real1 x17)))
+ (is_positive (abs2 x17))))) :pattern ((abs2 x17)) )))
+
+;; abs_finite_rev
+(assert
+ (forall ((x17 t))
+ (! (=>
+ (is_finite (abs2 x17))
+ (and
+ (is_finite x17)
+ (= (to_real1 (abs2 x17)) (abs1 (to_real1 x17))))) :pattern (
+ (abs2
+ x17)) )))
+
+;; abs_universal
+(assert
+ (forall ((x17 t))
+ (! (not (is_negative (abs2 x17))) :pattern ((abs2 x17)) )))
+
+;; fma_finite
+(assert
+ (forall ((m mode) (x17 t) (y t) (z t))
+ (! (=>
+ (is_finite x17)
+ (=>
+ (is_finite y)
+ (=>
+ (is_finite z)
+ (=>
+ (no_overflow
+ m
+ (infix_pldt
+ (infix_asdt (to_real1 x17) (to_real1 y))
+ (to_real1 z)))
+ (and
+ (is_finite (fma m x17 y z))
+ (= (to_real1 (fma m x17 y z)) (round
+ m
+ (infix_pldt
+ (infix_asdt
+ (to_real1 x17)
+ (to_real1 y))
+ (to_real1 z))))))))) :pattern (
+ (fma
+ m
+ x17
+ y
+ z)) )))
+
+;; fma_finite_rev
+(assert
+ (forall ((m mode) (x17 t) (y t) (z t))
+ (! (=>
+ (is_finite (fma m x17 y z))
+ (and (is_finite x17) (and (is_finite y) (is_finite z)))) :pattern (
+ (fma
+ m
+ x17
+ y
+ z)) )))
+
+;; fma_finite_rev_n
+(assert
+ (forall ((m mode) (x17 t) (y t) (z t))
+ (! (=>
+ (to_nearest m)
+ (=>
+ (is_finite (fma m x17 y z))
+ (and
+ (no_overflow
+ m
+ (infix_pldt
+ (infix_asdt (to_real1 x17) (to_real1 y))
+ (to_real1 z)))
+ (= (to_real1 (fma m x17 y z)) (round
+ m
+ (infix_pldt
+ (infix_asdt
+ (to_real1 x17)
+ (to_real1 y))
+ (to_real1 z))))))) :pattern (
+ (fma
+ m
+ x17
+ y
+ z)) )))
+
+;; sqr
+(define-fun sqr ((x17 Real)) Real
+ (* x17 x17))
+
+;; Sqrt_positive
+(assert (forall ((x17 Real)) (=> (>= x17 0.0) (>= (colibri_sqrt x17) 0.0))))
+
+;; Sqrt_square
+(assert
+ (forall ((x17 Real)) (=> (>= x17 0.0) (= (sqr (colibri_sqrt x17)) x17))))
+
+;; Square_sqrt
+(assert
+ (forall ((x17 Real)) (=> (>= x17 0.0) (= (colibri_sqrt (* x17 x17)) x17))))
+
+;; Sqrt_mul
+(assert
+ (forall ((x17 Real) (y Real))
+ (=>
+ (and (>= x17 0.0) (>= y 0.0))
+ (= (colibri_sqrt (* x17 y)) (* (colibri_sqrt x17) (colibri_sqrt y))))))
+
+;; Sqrt_le
+(assert
+ (forall ((x17 Real) (y Real))
+ (=>
+ (and (<= 0.0 x17) (<= x17 y))
+ (<= (colibri_sqrt x17) (colibri_sqrt y)))))
+
+;; sqrt_finite
+(assert
+ (forall ((m mode) (x17 t))
+ (! (=>
+ (is_finite x17)
+ (=>
+ (infix_gteqdt (to_real1 x17) 0.0)
+ (and
+ (is_finite (sqrt1 m x17))
+ (= (to_real1 (sqrt1 m x17)) (round
+ m
+ (colibri_sqrt (to_real1 x17))))))) :pattern (
+ (sqrt1
+ m
+ x17)) )))
+
+;; sqrt_finite_rev
+(assert
+ (forall ((m mode) (x17 t))
+ (! (=>
+ (is_finite (sqrt1 m x17))
+ (and
+ (is_finite x17)
+ (and
+ (infix_gteqdt (to_real1 x17) 0.0)
+ (= (to_real1 (sqrt1 m x17)) (round
+ m
+ (colibri_sqrt (to_real1 x17))))))) :pattern (
+ (sqrt1
+ m
+ x17)) )))
+
+;; same_sign_real
+(define-fun same_sign_real ((x17 t) (r3 Real)) Bool
+ (or
+ (and (is_positive x17) (infix_gtdt r3 0.0))
+ (and (is_negative x17) (infix_lsdt r3 0.0))))
+
+;; same_sign_real_round
+(assert
+ (forall ((x17 t) (m mode) (r3 Real))
+ (! (=> (same_sign_real x17 (round m r3)) (same_sign_real x17 r3)) :pattern (
+ (same_sign_real
+ x17
+ (round m r3))) )))
+
+;; m
+(declare-fun m () mode)
+
+;; x
+(declare-fun x17 () t)
+
+;; x
+(declare-fun x18 () finite)
+
+;; h
+(assert (= x17 (Finite x18)))
+
+;; y
+(declare-fun y () t)
+
+;; x
+(declare-fun x19 () finite)
+
+;; h
+(assert (= y (Finite x19)))
+
+;; r
+(define-fun r3 () t
+ (add m x17 y))
+
+;; h
+(assert (= r3 NaN1))
+
+;; H
+(assert (is_finite x17))
+
+;; H
+(assert (is_finite y))
+
+;; H
+(assert (not (no_overflow m (infix_pldt (to_real1 x17) (to_real1 y)))))
+
+;; h
+(assert (infix_gtdt (round m (infix_pldt (to_real1 x17) (to_real1 y))) 0.0))
+
+;; Goal add_special
+;; File "/home/bobot/Sources/colibrics/src_common/float_interval.mlw", line 609, characters 7-18
+(assert
+ (not
+ (or
+ (and
+ (is_positive r3)
+ (infix_gtdt (round m (infix_pldt (to_real1 x17) (to_real1 y))) 0.0))
+ (and
+ (is_negative r3)
+ (infix_lsdt (round m (infix_pldt (to_real1 x17) (to_real1 y))) 0.0)))))
+
+(check-sat)
diff --git a/src_colibri2/tests/solve/all/unsat/interval-Convexe-exists_memqtvc_2.psmt2 b/src_colibri2/tests/solve/all/unsat/interval-Convexe-exists_memqtvc_2.psmt2
index e0f3e1a2afcb09dc6e8ec61d498529a4f25edc7b..62d325e553fa75a80a623b1e54bbfe7cfd3a31cf 100644
--- a/src_colibri2/tests/solve/all/unsat/interval-Convexe-exists_memqtvc_2.psmt2
+++ b/src_colibri2/tests/solve/all/unsat/interval-Convexe-exists_memqtvc_2.psmt2
@@ -214,66 +214,66 @@
(=> (not (= den1 0))
(= (real (make num1 den1)) (/ (to_real num1) (to_real den1))))))
-(declare-fun truncate (Real) Int)
-
-;; Truncate_int
- (assert (forall ((i Int)) (= (truncate (to_real i)) i)))
-
-;; Truncate_down_pos
- (assert
- (forall ((x Real))
- (=> (>= x 0.0)
- (and (<= (to_real (truncate x)) x) (< x (to_real (+ (truncate x) 1)))))))
-
-;; Truncate_up_neg
- (assert
- (forall ((x Real))
- (=> (<= x 0.0)
- (and (< (to_real (- (truncate x) 1)) x) (<= x (to_real (truncate x)))))))
-
-;; Real_of_truncate
- (assert
- (forall ((x Real))
- (and (<= (- x 1.0) (to_real (truncate x)))
- (<= (to_real (truncate x)) (+ x 1.0)))))
-
-;; Truncate_monotonic
- (assert
- (forall ((x Real) (y Real)) (=> (<= x y) (<= (truncate x) (truncate y)))))
-
-;; Truncate_monotonic_int1
- (assert
- (forall ((x Real) (i Int)) (=> (<= x (to_real i)) (<= (truncate x) i))))
-
-;; Truncate_monotonic_int2
- (assert
- (forall ((x Real) (i Int)) (=> (<= (to_real i) x) (<= i (truncate x)))))
-
-;; Floor_int
- (assert (forall ((i Int)) (= (to_int (to_real i)) i)))
-
-;; Ceil_int
- (assert (forall ((i Int)) (= (- (to_int (- (to_real i)))) i)))
-
-;; Floor_down
- (assert
- (forall ((x Real))
- (and (<= (to_real (to_int x)) x) (< x (to_real (+ (to_int x) 1))))))
-
-;; Ceil_up
- (assert
- (forall ((x Real))
- (and (< (to_real (- (- (to_int (- x))) 1)) x)
- (<= x (to_real (- (to_int (- x))))))))
-
-;; Floor_monotonic
- (assert
- (forall ((x Real) (y Real)) (=> (<= x y) (<= (to_int x) (to_int y)))))
-
-;; Ceil_monotonic
- (assert
- (forall ((x Real) (y Real))
- (=> (<= x y) (<= (- (to_int (- x))) (- (to_int (- y)))))))
+;; (declare-fun truncate (Real) Int)
+
+;; ;; Truncate_int
+;; (assert (forall ((i Int)) (= (truncate (to_real i)) i)))
+
+;; ;; Truncate_down_pos
+;; (assert
+;; (forall ((x Real))
+;; (=> (>= x 0.0)
+;; (and (<= (to_real (truncate x)) x) (< x (to_real (+ (truncate x) 1)))))))
+
+;; ;; Truncate_up_neg
+;; (assert
+;; (forall ((x Real))
+;; (=> (<= x 0.0)
+;; (and (< (to_real (- (truncate x) 1)) x) (<= x (to_real (truncate x)))))))
+
+;; ;; Real_of_truncate
+;; (assert
+;; (forall ((x Real))
+;; (and (<= (- x 1.0) (to_real (truncate x)))
+;; (<= (to_real (truncate x)) (+ x 1.0)))))
+
+;; ;; Truncate_monotonic
+;; (assert
+;; (forall ((x Real) (y Real)) (=> (<= x y) (<= (truncate x) (truncate y)))))
+
+;; ;; Truncate_monotonic_int1
+;; (assert
+;; (forall ((x Real) (i Int)) (=> (<= x (to_real i)) (<= (truncate x) i))))
+
+;; ;; Truncate_monotonic_int2
+;; (assert
+;; (forall ((x Real) (i Int)) (=> (<= (to_real i) x) (<= i (truncate x)))))
+
+;; ;; Floor_int
+;; (assert (forall ((i Int)) (= (to_int (to_real i)) i)))
+
+;; ;; Ceil_int
+;; (assert (forall ((i Int)) (= (- (to_int (- (to_real i)))) i)))
+
+;; ;; Floor_down
+;; (assert
+;; (forall ((x Real))
+;; (and (<= (to_real (to_int x)) x) (< x (to_real (+ (to_int x) 1))))))
+
+;; ;; Ceil_up
+;; (assert
+;; (forall ((x Real))
+;; (and (< (to_real (- (- (to_int (- x))) 1)) x)
+;; (<= x (to_real (- (to_int (- x))))))))
+
+;; ;; Floor_monotonic
+;; (assert
+;; (forall ((x Real) (y Real)) (=> (<= x y) (<= (to_int x) (to_int y)))))
+
+;; ;; Ceil_monotonic
+;; (assert
+;; (forall ((x Real) (y Real))
+;; (=> (<= x y) (<= (- (to_int (- x))) (- (to_int (- y)))))))
(declare-datatypes ((t2 0))
(((Strict) (Large))))
diff --git a/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a.psmt2 b/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a.psmt2
new file mode 100644
index 0000000000000000000000000000000000000000..165ff7a4254c9ade85a78accd4072138c09af00d
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a.psmt2
@@ -0,0 +1,672 @@
+;; produced by local colibri2.drv ;;
+(set-logic ALL)
+(set-info :smt-lib-version 2.6)
+;;; SMT-LIB2: integer arithmetic
+;;; SMT-LIB2: real arithmetic
+(declare-sort string 0)
+
+(declare-datatypes ((tuple0 0))
+ (((Tuple0))))
+
+;; abs
+(define-fun abs1 ((x Int)) Int
+ (ite (>= x 0) x (- x)))
+
+;; Abs_le
+(assert
+ (forall ((x Int) (y Int)) (= (<= (abs1 x) y) (and (<= (- y) x) (<= x y)))))
+
+;; Abs_pos
+(assert (forall ((x Int)) (>= (abs1 x) 0)))
+
+;; div
+(declare-fun div1 (Int
+ Int) Int)
+
+;; mod
+(declare-fun mod1 (Int
+ Int) Int)
+
+;; Div_mod
+(assert
+ (forall ((x Int) (y Int))
+ (=> (not (= y 0)) (= x (+ (* y (div1 x y)) (mod1 x y))))))
+
+;; Div_bound
+(assert
+ (forall ((x Int) (y Int))
+ (=> (and (>= x 0) (> y 0)) (and (<= 0 (div1 x y)) (<= (div1 x y) x)))))
+
+;; Mod_bound
+(assert
+ (forall ((x Int) (y Int))
+ (=>
+ (not (= y 0))
+ (and (< (- (abs1 y)) (mod1 x y)) (< (mod1 x y) (abs1 y))))))
+
+;; Div_sign_pos
+(assert
+ (forall ((x Int) (y Int)) (=> (and (>= x 0) (> y 0)) (>= (div1 x y) 0))))
+
+;; Div_sign_neg
+(assert
+ (forall ((x Int) (y Int)) (=> (and (<= x 0) (> y 0)) (<= (div1 x y) 0))))
+
+;; Mod_sign_pos
+(assert
+ (forall ((x Int) (y Int))
+ (=> (and (>= x 0) (not (= y 0))) (>= (mod1 x y) 0))))
+
+;; Mod_sign_neg
+(assert
+ (forall ((x Int) (y Int))
+ (=> (and (<= x 0) (not (= y 0))) (<= (mod1 x y) 0))))
+
+;; Rounds_toward_zero
+(assert
+ (forall ((x Int) (y Int))
+ (=> (not (= y 0)) (<= (abs1 (* (div1 x y) y)) (abs1 x)))))
+
+;; Div_1
+(assert (forall ((x Int)) (= (div1 x 1) x)))
+
+;; Mod_1
+(assert (forall ((x Int)) (= (mod1 x 1) 0)))
+
+;; Div_inf
+(assert
+ (forall ((x Int) (y Int)) (=> (and (<= 0 x) (< x y)) (= (div1 x y) 0))))
+
+;; Mod_inf
+(assert
+ (forall ((x Int) (y Int)) (=> (and (<= 0 x) (< x y)) (= (mod1 x y) x))))
+
+;; Div_mult
+(assert
+ (forall ((x Int) (y Int) (z Int))
+ (! (=>
+ (and (> x 0) (and (>= y 0) (>= z 0)))
+ (= (div1 (+ (* x y) z) x) (+ y (div1 z x)))) :pattern ((div1
+ (+ (* x y) z)
+ x)) )))
+
+;; Mod_mult
+(assert
+ (forall ((x Int) (y Int) (z Int))
+ (! (=>
+ (and (> x 0) (and (>= y 0) (>= z 0)))
+ (= (mod1 (+ (* x y) z) x) (mod1 z x))) :pattern ((mod1
+ (+ (* x y) z)
+ x)) )))
+
+;; add_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (+ x y) z) (+ (/ x z) (/ y z))))))
+
+;; sub_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (- x y) z) (- (/ x z) (/ y z))))))
+
+;; neg_div
+(assert
+ (forall ((x Real) (y Real))
+ (=> (not (= y 0.0)) (= (/ (- x) y) (- (/ x y))))))
+
+;; assoc_mul_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=> (not (= z 0.0)) (= (/ (* x y) z) (* x (/ y z))))))
+
+;; assoc_div_mul
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=>
+ (and (not (= y 0.0)) (not (= z 0.0)))
+ (= (/ (/ x y) z) (/ x (* y z))))))
+
+;; assoc_div_div
+(assert
+ (forall ((x Real) (y Real) (z Real))
+ (=>
+ (and (not (= y 0.0)) (not (= z 0.0)))
+ (= (/ x (/ y z)) (/ (* x z) y)))))
+
+;; infix +.
+(define-fun infix_pldt ((x Real) (y Real)) Real
+ (+ x y))
+
+;; infix -.
+(define-fun infix_mndt ((x Real) (y Real)) Real
+ (- x y))
+
+;; infix *.
+(define-fun infix_asdt ((x Real) (y Real)) Real
+ (* x y))
+
+;; infix /.
+(define-fun infix_sldt ((x Real) (y Real)) Real
+ (/ x y))
+
+;; prefix -.
+(define-fun prefix_mndt ((x Real)) Real
+ (- x))
+
+;; inv
+(define-fun inv ((x Real)) Real
+ (/ 1.0 x))
+
+;; infix <=.
+(define-fun infix_lseqdt ((x Real) (y Real)) Bool
+ (<= x y))
+
+;; infix >=.
+(define-fun infix_gteqdt ((x Real) (y Real)) Bool
+ (>= x y))
+
+;; infix <.
+(define-fun infix_lsdt ((x Real) (y Real)) Bool
+ (< x y))
+
+;; infix >.
+(define-fun infix_gtdt ((x Real) (y Real)) Bool
+ (> x y))
+
+;; Zero
+(assert (= (to_real 0) 0.0))
+
+;; One
+(assert (= (to_real 1) 1.0))
+
+;; Add
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (+ x y)) (+ (to_real x) (to_real y)))))
+
+;; Sub
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (- x y)) (- (to_real x) (to_real y)))))
+
+;; Mul
+(assert
+ (forall ((x Int) (y Int))
+ (= (to_real (* x y)) (* (to_real x) (to_real y)))))
+
+;; Neg
+(assert (forall ((x Int)) (= (to_real (- x)) (- (to_real x)))))
+
+;; Injective
+(assert (forall ((x Int) (y Int)) (=> (= (to_real x) (to_real y)) (= x y))))
+
+;; Monotonic
+(assert
+ (forall ((x Int) (y Int)) (=> (<= x y) (<= (to_real x) (to_real y)))))
+
+;; eqb
+(declare-fun eqb (par (a)
+ (a
+ a) Bool))
+
+;; eqb
+(assert (par (a) (forall ((x a) (y a)) (= (= (eqb x y) true) (= x y)))))
+
+;; neqb
+(declare-fun neqb (par (a)
+ (a
+ a) Bool))
+
+;; neqb
+(assert (par (a)
+ (forall ((x a) (y a)) (= (= (neqb x y) true) (not (= x y))))))
+
+;; zlt
+(declare-fun zlt (Int
+ Int) Bool)
+
+;; zleq
+(declare-fun zleq (Int
+ Int) Bool)
+
+;; zlt
+(assert (forall ((x Int) (y Int)) (= (= (zlt x y) true) (< x y))))
+
+;; zleq
+(assert (forall ((x Int) (y Int)) (= (= (zleq x y) true) (<= x y))))
+
+;; rlt
+(declare-fun rlt (Real
+ Real) Bool)
+
+;; rleq
+(declare-fun rleq (Real
+ Real) Bool)
+
+;; rlt
+(assert (forall ((x Real) (y Real)) (= (= (rlt x y) true) (infix_lsdt x y))))
+
+;; rleq
+(assert
+ (forall ((x Real) (y Real)) (= (= (rleq x y) true) (infix_lseqdt x y))))
+
+;; real_of_int
+(define-fun real_of_int ((x Int)) Real
+ (to_real x))
+
+;; c_euclidian
+(assert
+ (forall ((n Int) (d Int))
+ (! (=> (not (= d 0)) (= n (+ (* (div1 n d) d) (mod1 n d)))) :pattern (
+ (div1
+ n
+ d)
+ (mod1 n d)) )))
+
+;; cmod_remainder
+(assert
+ (forall ((n Int) (d Int))
+ (! (and
+ (=> (>= n 0) (=> (> d 0) (and (<= 0 (mod1 n d)) (< (mod1 n d) d))))
+ (and
+ (=>
+ (<= n 0)
+ (=> (> d 0) (and (< (- d) (mod1 n d)) (<= (mod1 n d) 0))))
+ (and
+ (=>
+ (>= n 0)
+ (=> (< d 0) (and (<= 0 (mod1 n d)) (< (mod1 n d) (- d)))))
+ (=>
+ (<= n 0)
+ (=> (< d 0) (and (< d (mod1 n d)) (<= (mod1 n d) 0))))))) :pattern (
+ (mod1
+ n
+ d)) )))
+
+;; cdiv_neutral
+(assert (forall ((a1 Int)) (! (= (div1 a1 1) a1) :pattern ((div1 a1 1)) )))
+
+;; cdiv_inv
+(assert
+ (forall ((a1 Int))
+ (! (=> (not (= a1 0)) (= (div1 a1 a1) 1)) :pattern ((div1 a1 a1)) )))
+
+;; cdiv_closed_remainder
+(assert
+ (forall ((a1 Int) (b Int) (n Int))
+ (=>
+ (<= 0 a1)
+ (=>
+ (<= 0 b)
+ (=>
+ (and (<= 0 (- b a1)) (< (- b a1) n))
+ (=> (= (mod1 a1 n) (mod1 b n)) (= a1 b)))))))
+
+(declare-sort infix_mngt 2)
+
+;; infix @
+(declare-fun infix_at (par (a1
+ b)
+ ((infix_mngt a1
+ b)
+ a1) b))
+
+;; get
+(define-fun get (par (a
+ b1)
+ ((f (infix_mngt a b1)) (x a)) b1
+ (infix_at f x)))
+
+;; set
+(declare-fun set (par (a
+ b1)
+ ((infix_mngt a
+ b1)
+ a
+ b1) (infix_mngt a
+ b1)))
+
+;; set'def
+(assert (par (a b1)
+ (forall ((f (infix_mngt a b1)) (x a) (v b1) (y a))
+ (= (infix_at (set f x v) y) (ite (= y x) v (infix_at f y))))))
+
+;; mixfix []
+(define-fun mixfix_lbrb (par (a
+ b1)
+ ((f (infix_mngt a b1)) (x a)) b1
+ (infix_at f x)))
+
+;; mixfix [<-]
+(define-fun mixfix_lblsmnrb (par (a
+ b1)
+ ((f (infix_mngt a b1)) (x a) (v b1)) (infix_mngt a b1)
+ (set f x v)))
+
+(declare-datatypes ((Init_S1_S 0))
+ (((Init_S1_S1 (Init_F1_S_i Bool)(Init_F1_S_a (infix_mngt Int Bool))))))
+
+(declare-datatypes ((S1_S 0))
+ (((S1_S1 (F1_S_i Int)(F1_S_a (infix_mngt Int Int))))))
+
+;; max_uint8
+(define-fun max_uint8 () Int
+ 256)
+
+;; max_sint8
+(define-fun max_sint8 () Int
+ 128)
+
+;; max_uint16
+(define-fun max_uint16 () Int
+ 65536)
+
+;; max_sint16
+(define-fun max_sint16 () Int
+ 32768)
+
+;; max_uint32
+(define-fun max_uint32 () Int
+ 4294967296)
+
+;; max_sint32
+(define-fun max_sint32 () Int
+ 2147483648)
+
+;; max_uint64
+(define-fun max_uint64 () Int
+ 18446744073709551616)
+
+;; max_sint64
+(define-fun max_sint64 () Int
+ 9223372036854775808)
+
+;; is_bool
+(define-fun is_bool ((x Int)) Bool
+ (or (= x 0) (= x 1)))
+
+;; is_uint8
+(declare-fun is_uint8 (Int) Bool)
+
+;; is_uint8_def
+(assert
+ (forall ((x Int))
+ (! (= (is_uint8 x) (and (<= 0 x) (< x max_uint8))) :pattern ((is_uint8 x)) )))
+
+;; is_sint8
+(declare-fun is_sint8 (Int) Bool)
+
+;; is_sint8_def
+(assert
+ (forall ((x Int))
+ (! (= (is_sint8 x) (and (<= (- max_sint8) x) (< x max_sint8))) :pattern (
+ (is_sint8
+ x)) )))
+
+;; is_uint16
+(declare-fun is_uint16 (Int) Bool)
+
+;; is_uint16_def
+(assert
+ (forall ((x Int))
+ (! (= (is_uint16 x) (and (<= 0 x) (< x max_uint16))) :pattern ((is_uint16
+ x)) )))
+
+;; is_sint16
+(define-fun is_sint16 ((x Int)) Bool
+ (and (<= (- max_sint16) x) (< x max_sint16)))
+
+;; is_uint32
+(declare-fun is_uint32 (Int) Bool)
+
+;; is_uint32_def
+(assert
+ (forall ((x Int))
+ (! (= (is_uint32 x) (and (<= 0 x) (< x max_uint32))) :pattern ((is_uint32
+ x)) )))
+
+;; is_sint32
+(declare-fun is_sint32 (Int) Bool)
+
+;; is_sint32_def
+(assert
+ (forall ((x Int))
+ (! (= (is_sint32 x) (and (<= (- max_sint32) x) (< x max_sint32))) :pattern (
+ (is_sint32
+ x)) )))
+
+;; is_uint64
+(declare-fun is_uint64 (Int) Bool)
+
+;; is_uint64_def
+(assert
+ (forall ((x Int))
+ (! (= (is_uint64 x) (and (<= 0 x) (< x max_uint64))) :pattern ((is_uint64
+ x)) )))
+
+;; is_sint64
+(declare-fun is_sint64 (Int) Bool)
+
+;; is_sint64_def
+(assert
+ (forall ((x Int))
+ (! (= (is_sint64 x) (and (<= (- max_sint64) x) (< x max_sint64))) :pattern (
+ (is_sint64
+ x)) )))
+
+;; is_bool0
+(assert (is_bool 0))
+
+;; is_bool1
+(assert (is_bool 1))
+
+;; to_bool
+(define-fun to_bool ((x Int)) Int
+ (ite (= x 0) 0 1))
+
+;; to_uint8
+(declare-fun to_uint8 (Int) Int)
+
+;; to_sint8
+(declare-fun to_sint8 (Int) Int)
+
+;; to_uint16
+(declare-fun to_uint16 (Int) Int)
+
+;; to_sint16
+(declare-fun to_sint16 (Int) Int)
+
+;; to_uint32
+(declare-fun to_uint32 (Int) Int)
+
+;; to_sint32
+(declare-fun to_sint32 (Int) Int)
+
+;; to_uint64
+(declare-fun to_uint64 (Int) Int)
+
+;; to_sint64
+(declare-fun to_sint64 (Int) Int)
+
+;; two_power_abs
+(declare-fun two_power_abs (Int) Int)
+
+;; is_uint
+(define-fun is_uint ((n Int) (x Int)) Bool
+ (and (<= 0 x) (< x (two_power_abs n))))
+
+;; is_sint
+(define-fun is_sint ((n Int) (x Int)) Bool
+ (and (<= (- (two_power_abs n)) x) (< x (two_power_abs n))))
+
+;; to_uint
+(declare-fun to_uint (Int
+ Int) Int)
+
+;; to_sint
+(declare-fun to_sint (Int
+ Int) Int)
+
+;; is_to_uint8
+(assert (forall ((x Int)) (is_uint8 (to_uint8 x))))
+
+;; is_to_sint8
+(assert (forall ((x Int)) (is_sint8 (to_sint8 x))))
+
+;; is_to_uint16
+(assert (forall ((x Int)) (is_uint16 (to_uint16 x))))
+
+;; is_to_sint16
+(assert (forall ((x Int)) (is_sint16 (to_sint16 x))))
+
+;; is_to_uint32
+(assert (forall ((x Int)) (is_uint32 (to_uint32 x))))
+
+;; is_to_sint32
+(assert (forall ((x Int)) (is_sint32 (to_sint32 x))))
+
+;; is_to_uint64
+(assert (forall ((x Int)) (is_uint64 (to_uint64 x))))
+
+;; is_to_sint64
+(assert (forall ((x Int)) (is_sint64 (to_sint64 x))))
+
+;; id_uint8
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= 0 x) (< x max_uint8)) (= (to_uint8 x) x)) :pattern (
+ (to_uint8
+ x)) )))
+
+;; id_sint8
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= (- max_sint8) x) (< x max_sint8)) (= (to_sint8 x) x)) :pattern (
+ (to_sint8
+ x)) )))
+
+;; id_uint16
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= 0 x) (< x max_uint16)) (= (to_uint16 x) x)) :pattern (
+ (to_uint16
+ x)) )))
+
+;; id_sint16
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= (- max_sint16) x) (< x max_sint16)) (= (to_sint16 x) x)) :pattern (
+ (to_sint16
+ x)) )))
+
+;; id_uint32
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= 0 x) (< x max_uint32)) (= (to_uint32 x) x)) :pattern (
+ (to_uint32
+ x)) )))
+
+;; id_sint32
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= (- max_sint32) x) (< x max_sint32)) (= (to_sint32 x) x)) :pattern (
+ (to_sint32
+ x)) )))
+
+;; id_uint64
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= 0 x) (< x max_uint64)) (= (to_uint64 x) x)) :pattern (
+ (to_uint64
+ x)) )))
+
+;; id_sint64
+(assert
+ (forall ((x Int))
+ (! (=> (and (<= (- max_sint64) x) (< x max_sint64)) (= (to_sint64 x) x)) :pattern (
+ (to_sint64
+ x)) )))
+
+;; proj_int8
+(assert
+ (forall ((x Int))
+ (! (= (to_sint8 (to_uint8 x)) (to_sint8 x)) :pattern ((to_sint8
+ (to_uint8 x))) )))
+
+;; proj_int16
+(assert
+ (forall ((x Int))
+ (! (= (to_sint16 (to_uint16 x)) (to_sint16 x)) :pattern ((to_sint16
+ (to_uint16 x))) )))
+
+;; proj_int32
+(assert
+ (forall ((x Int))
+ (! (= (to_sint32 (to_uint32 x)) (to_sint32 x)) :pattern ((to_sint32
+ (to_uint32 x))) )))
+
+;; proj_int64
+(assert
+ (forall ((x Int))
+ (! (= (to_sint64 (to_uint64 x)) (to_sint64 x)) :pattern ((to_sint64
+ (to_uint64 x))) )))
+
+;; Goal wp_goal
+(assert
+ (not
+ (forall ((S Init_S1_S) (i Int) (i1 Int) (S1 S1_S) (t (infix_mngt Int Bool)) (t1 (infix_mngt Int Int)))
+ (let ((a2 (Init_F1_S_a S)))
+ (=>
+ (= (F1_S_i S1) 0)
+ (=>
+ (< 0 i1)
+ (=>
+ (<= 0 i)
+ (=>
+ (<= i1 4)
+ (=>
+ (<= i1 9)
+ (=>
+ (<= 10 i)
+ (=>
+ (<= i 10)
+ (=>
+ (is_sint32 i1)
+ (=>
+ (is_sint32 i)
+ (=>
+ (= (Init_F1_S_i S) true)
+ (=>
+ (=>
+ (< 0 i)
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=> (< i2 i) (= (get t i2) true)))))
+ (=>
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=> (<= i2 9) (= (get t i2) true))))
+ (=>
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=> (<= i2 9) (= (get a2 i2) true))))
+ (=>
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=>
+ (<= i2 9)
+ (=>
+ (or (<= i2 0) (<= 5 i2))
+ (= (get (F1_S_a S1) i2) (get t1 i2))))))
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=>
+ (<= i2 9)
+ (= (get (set a2 i1 true) i2) true))))))))))))))))))))))
+
+(check-sat)
diff --git a/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a_simplified.psmt2 b/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a_simplified.psmt2
new file mode 100644
index 0000000000000000000000000000000000000000..65d2ea3b02d2a8ba9a43e7cfec2daa4f5dc9f52d
--- /dev/null
+++ b/src_colibri2/tests/solve/all/unsat/range_loop_invariant_CHECK_preserved_Why3_Colibri2_n_a_simplified.psmt2
@@ -0,0 +1,51 @@
+;; simplified version of a WP VC, the full one is next to it ;;
+(set-logic ALL)
+(declare-sort infix_mngt 2)
+
+;; infix @
+(declare-fun infix_at (par (a1
+ b)
+ ((infix_mngt a1
+ b)
+ a1) b))
+
+;; get
+(define-fun get (par (a
+ b1)
+ ((f (infix_mngt a b1)) (x a)) b1
+ (infix_at f x)))
+
+;; set
+(declare-fun set (par (a
+ b1)
+ ((infix_mngt a
+ b1)
+ a
+ b1) (infix_mngt a
+ b1)))
+
+;; set'def
+(assert (par (a b1)
+ (forall ((f (infix_mngt a b1)) (x a) (v b1) (y a))
+ (= (infix_at (set f x v) y) (ite (= y x) v (infix_at f y))))))
+
+(declare-datatypes ((Init_S1_S 0))
+ (((Init_S1_S1 (Init_F1_S_i Bool)(Init_F1_S_a (infix_mngt Int Bool))))))
+
+(assert
+ (not
+ (forall ((S Init_S1_S) (i1 Int))
+ (let ((a2 (Init_F1_S_a S)))
+ (=>
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=> (<= i2 9) (= (get a2 i2) true))))
+ (forall ((i2 Int))
+ (=>
+ (<= 0 i2)
+ (=>
+ (<= i2 9)
+ (= (get (set a2 i1 true) i2) true)))))))))
+
+(check-sat)
diff --git a/src_colibri2/tests/solve/all/unsat/union-Union-interqtvc_10.psmt2 b/src_colibri2/tests/solve/all/unsat/union-Union-interqtvc_10.psmt2
index bd1131159f0eeaacbd0021e4559f0d2e9fc55613..965632576e3d90ba6e55110201466ecdc445ac94 100644
--- a/src_colibri2/tests/solve/all/unsat/union-Union-interqtvc_10.psmt2
+++ b/src_colibri2/tests/solve/all/unsat/union-Union-interqtvc_10.psmt2
@@ -1,7 +1,7 @@
;; produced by local colibri2.drv ;;
(set-logic ALL)
(set-info :smt-lib-version 2.6)
-(set-option :max-steps-colibri2 10000)
+(set-option :max-steps-colibri2 30000)
;;; SMT-LIB2: integer arithmetic
;;; SMT-LIB2: real arithmetic
(declare-sort string 0)
diff --git a/src_colibri2/tests/solve/all/unsat/work_with_fourier_not_simplex2.psmt2 b/src_colibri2/tests/solve/all/unsat/work_with_fourier_not_simplex2.psmt2
index ce7b27a36cedef1ff8c8b5e9c3f8b4f25a53f95a..2119077046b0d362bb8aa55f7a0982512d3ecd6b 100644
--- a/src_colibri2/tests/solve/all/unsat/work_with_fourier_not_simplex2.psmt2
+++ b/src_colibri2/tests/solve/all/unsat/work_with_fourier_not_simplex2.psmt2
@@ -269,70 +269,70 @@
(= (real (make num1 den1)) (/ (to_real num1) (to_real den1))))))
;; truncate
-(declare-fun truncate (Real) Int)
+;;(declare-fun truncate (Real) Int)
;; Truncate_int
-(assert (forall ((i Int)) (= (truncate (to_real i)) i)))
+;;(assert (forall ((i Int)) (= (truncate (to_real i)) i)))
;; Truncate_down_pos
-(assert
- (forall ((x Real))
- (=>
- (>= x 0.0)
- (and (<= (to_real (truncate x)) x) (< x (to_real (+ (truncate x) 1)))))))
+;;;; (assert
+;;;; (forall ((x Real))
+;;;; (=>
+;;;; (>= x 0.0)
+;;;; (and (<= (to_real (truncate x)) x) (< x (to_real (+ (truncate x) 1)))))))
;; Truncate_up_neg
-(assert
- (forall ((x Real))
- (=>
- (<= x 0.0)
- (and (< (to_real (- (truncate x) 1)) x) (<= x (to_real (truncate x)))))))
-
-;; Real_of_truncate
-(assert
- (forall ((x Real))
- (and
- (<= (- x 1.0) (to_real (truncate x)))
- (<= (to_real (truncate x)) (+ x 1.0)))))
-
-;; Truncate_monotonic
-(assert
- (forall ((x Real) (y Real)) (=> (<= x y) (<= (truncate x) (truncate y)))))
+;; (assert
+;; (forall ((x Real))
+;; (=>
+;; (<= x 0.0)
+;; (and (< (to_real (- (truncate x) 1)) x) (<= x (to_real (truncate x)))))))
+
+;;;; ;; Real_of_truncate
+;;;; (assert
+;;;; (forall ((x Real))
+;;;; (and
+;;;; (<= (- x 1.0) (to_real (truncate x)))
+;;;; (<= (to_real (truncate x)) (+ x 1.0)))))
+
+;;;; ;; Truncate_monotonic
+;;;; (assert
+;;;; (forall ((x Real) (y Real)) (=> (<= x y) (<= (truncate x) (truncate y)))))
;; Truncate_monotonic_int1
-(assert
- (forall ((x Real) (i Int)) (=> (<= x (to_real i)) (<= (truncate x) i))))
-
-;; Truncate_monotonic_int2
-(assert
- (forall ((x Real) (i Int)) (=> (<= (to_real i) x) (<= i (truncate x)))))
-
-;; Floor_int
-(assert (forall ((i Int)) (= (to_int (to_real i)) i)))
-
-;; Ceil_int
-(assert (forall ((i Int)) (= (- (to_int (- (to_real i)))) i)))
-
-;; Floor_down
-(assert
- (forall ((x Real))
- (and (<= (to_real (to_int x)) x) (< x (to_real (+ (to_int x) 1))))))
-
-;; Ceil_up
-(assert
- (forall ((x Real))
- (and
- (< (to_real (- (- (to_int (- x))) 1)) x)
- (<= x (to_real (- (to_int (- x))))))))
-
-;; Floor_monotonic
-(assert
- (forall ((x Real) (y Real)) (=> (<= x y) (<= (to_int x) (to_int y)))))
-
-;; Ceil_monotonic
-(assert
- (forall ((x Real) (y Real))
- (=> (<= x y) (<= (- (to_int (- x))) (- (to_int (- y)))))))
+;; (assert
+;; (forall ((x Real) (i Int)) (=> (<= x (to_real i)) (<= (truncate x) i))))
+
+;;;; ;; Truncate_monotonic_int2
+;;;; (assert
+;;;; (forall ((x Real) (i Int)) (=> (<= (to_real i) x) (<= i (truncate x)))))
+
+;;;; ;; Floor_int
+;;;; (assert (forall ((i Int)) (= (to_int (to_real i)) i)))
+
+;;;; ;; Ceil_int
+;;;; (assert (forall ((i Int)) (= (- (to_int (- (to_real i)))) i)))
+
+;;;; ;; Floor_down
+;;;; (assert
+;;;; (forall ((x Real))
+;;;; (and (<= (to_real (to_int x)) x) (< x (to_real (+ (to_int x) 1))))))
+
+;;;; ;; Ceil_up
+;;;; (assert
+;;;; (forall ((x Real))
+;;;; (and
+;;;; (< (to_real (- (- (to_int (- x))) 1)) x)
+;;;; (<= x (to_real (- (to_int (- x))))))))
+
+;;;; ;; Floor_monotonic
+;;;; (assert
+;;;; (forall ((x Real) (y Real)) (=> (<= x y) (<= (to_int x) (to_int y)))))
+
+;;;; ;; Ceil_monotonic
+;;;; (assert
+;;;; (forall ((x Real) (y Real))
+;;;; (=> (<= x y) (<= (- (to_int (- x))) (- (to_int (- y)))))))
(declare-datatypes ((t2 0))
(((Strict) (Large))))
diff --git a/src_colibri2/theories/ADT/adt.ml b/src_colibri2/theories/ADT/adt.ml
index cef2681da0c81e999a7294f1f4aaaed16c968c0f..a2a97564c5ebfd7d8724720ce1500f9d13c865f6 100644
--- a/src_colibri2/theories/ADT/adt.ml
+++ b/src_colibri2/theories/ADT/adt.ml
@@ -122,8 +122,12 @@ let converter d (f : Ground.t) =
app = { builtin = Expr.Destructor { case; field; adt; _ }; _ };
args;
tyargs;
+ ty;
_;
} ->
+ (* not completely satisfactory but needed, it is not yet clear who has the responsibility of choice for booleans *)
+ if Ground.Ty.(equal ty bool) then
+ Choice.register_thterm d (Ground.thterm f) (Boolean.chobool r);
let case = case_of_int case in
let field = field_of_int field in
let adt = Option.value_exn (Adt_value.MonoAdt.index adt tyargs) in
diff --git a/src_colibri2/theories/LRA/delta.ml b/src_colibri2/theories/LRA/delta.ml
index 130c89299f8f0432bdaeb09c1e2e58f0e61b0c61..eb67f3ca68bb5787d4dd47ae5869a2c0224c7c5f 100644
--- a/src_colibri2/theories/LRA/delta.ml
+++ b/src_colibri2/theories/LRA/delta.ml
@@ -65,7 +65,7 @@ let ta = Expr.Term.of_var a
let floor_pattern =
(* Other floor functions? *)
- Colibri2_theories_quantifiers.Pattern.of_term ~subst:Ground.Subst.empty
+ Colibri2_theories_quantifiers.Pattern.of_term_exn ~subst:Ground.Subst.empty
(Expr.Term.Real.floor_to_int ta)
(* let ceiling_patterns =
@@ -73,7 +73,7 @@ let floor_pattern =
* (Expr.Term.Real.ceiling ta) *)
let ceiling_pattern =
- Colibri2_theories_quantifiers.Pattern.of_term ~subst:Ground.Subst.empty
+ Colibri2_theories_quantifiers.Pattern.of_term_exn ~subst:Ground.Subst.empty
(Expr.Term.Int.minus
(Expr.Term.Real.floor_to_int (Expr.Term.Real.minus ta)))
diff --git a/src_colibri2/theories/LRA/dom_interval.ml b/src_colibri2/theories/LRA/dom_interval.ml
index a3f80025160209441b3d79c78692364b31d01a5e..e20db442b859c76ab3dd5d21d97dd4eb874a72b6 100644
--- a/src_colibri2/theories/LRA/dom_interval.ml
+++ b/src_colibri2/theories/LRA/dom_interval.ml
@@ -266,6 +266,22 @@ module Propagate = struct
| { app = { builtin = Expr.Gt }; tyargs = []; args; _ } ->
let a, b = IArray.extract2_exn args in
cmp d `Gt ~r ~a ~b
+ | {
+ app =
+ {
+ builtin = Expr.Floor | Expr.Ceiling | Expr.Floor_to_int | Expr.Truncate;
+ };
+ tyargs = [];
+ args;
+ _;
+ } ->
+ let a = IArray.extract1_exn args in
+ upd_dom d r D.integers;
+ attach d
+ (exec
+ (fun d -> Egraph.merge d a r)
+ (let+ va = get a in
+ D.is_integer va))
| { app = { builtin = Expr.Equal }; tyargs = _; args; _ } ->
if IArray.length args = 2 then (
let a, b = IArray.extract2_exn args in
diff --git a/src_colibri2/theories/LRA/dom_product.ml b/src_colibri2/theories/LRA/dom_product.ml
index 4ce380cdd07b2e8549111296bc76f1661fd339ef..7da8bbdfc2da0b01e5aa778b15d0a75e26a49284 100644
--- a/src_colibri2/theories/LRA/dom_product.ml
+++ b/src_colibri2/theories/LRA/dom_product.ml
@@ -335,7 +335,8 @@ let converter d (f : Ground.t) =
(* a = res ^ 2 *)
SolveAbs.assume_equality d a
(Product.of_list A.one [ (res, Q.two) ]);
- SolveSign.assume_equality d res Sign_product.one))
+ (* sign res = sign a (don't forget 0 case) *)
+ SolveSign.assume_equality d res (Sign_product.of_one_node a)))
| { app = { builtin = Expr.Add }; tyargs = []; args; _ } ->
let a, b = IArray.extract2_exn args in
reg a;
diff --git a/src_colibri2/theories/LRA/realValue.ml b/src_colibri2/theories/LRA/realValue.ml
index 47e6350781509cdf4782ffe496b14ca625caef6e..65b85afd0c4c67d6f7c0c94ab95c0b895a1ac24e 100644
--- a/src_colibri2/theories/LRA/realValue.ml
+++ b/src_colibri2/theories/LRA/realValue.ml
@@ -60,6 +60,16 @@ module Builtin = struct
(Dolmen_std.Path.global "colibri_floor")
(Expr.Ty.arrow [ Expr.Ty.real ] Expr.Ty.real)
+ let colibri_truncate =
+ Expr.Id.mk ~name:"colibri_truncate" ~builtin:Expr.Truncate
+ (Dolmen_std.Path.global "colibri_truncate")
+ (Expr.Ty.arrow [ Expr.Ty.real ] Expr.Ty.real)
+
+ let colibri_truncate_to_int =
+ Expr.Id.mk ~name:"colibri_truncate_to_int" ~builtin:Expr.Truncate
+ (Dolmen_std.Path.global "colibri_truncate_to_int")
+ (Expr.Ty.arrow [ Expr.Ty.real ] Expr.Ty.int)
+
let colibri_sqrt =
Expr.Id.mk ~name:"colibri_sqrt" ~builtin:Sqrt
(Dolmen_std.Path.global "colibri_sqrt")
@@ -136,6 +146,14 @@ module Builtin = struct
app2 env s colibri_cdiv
| Dolmen_loop.Typer.T.Id { ns = Term; name = Simple "colibri_ceil" } ->
app1 env s colibri_ceil
+ | Dolmen_loop.Typer.T.Id { ns = Term; name = Simple "colibri_floor" } ->
+ app1 env s colibri_floor
+ | Dolmen_loop.Typer.T.Id { ns = Term; name = Simple "colibri_truncate" }
+ ->
+ app1 env s colibri_truncate
+ | Dolmen_loop.Typer.T.Id
+ { ns = Term; name = Simple "colibri_truncate_to_int" } ->
+ app1 env s colibri_truncate_to_int
| Dolmen_loop.Typer.T.Id { ns = Term; name = Simple "colibri_sqrt" } ->
app1 env s colibri_sqrt
| Dolmen_loop.Typer.T.Id { ns = Term; name = Simple "colibri_crem" } ->
@@ -373,6 +391,9 @@ module Check = struct
| { app = { builtin = Expr.Floor }; tyargs = []; args; _ } ->
let a = IArray.extract1_exn args in
!<(A.floor !>a)
+ | { app = { builtin = Expr.Truncate }; tyargs = []; args; _ } ->
+ let a = IArray.extract1_exn args in
+ !<(A.truncate !>a)
| { app = { builtin = Builtin.Sqrt }; tyargs = []; args; _ } ->
let a = IArray.extract1_exn args in
let a = !>a in
@@ -899,13 +920,66 @@ let converter d (f : Ground.t) =
Check.attach d f
| _ -> ()
+module Quantifier_skipped = struct
+ open Colibri2_theories_quantifiers.Quantifier.Quantifier_skipped
+
+ let coercion a = App (Expr.Coercion, [ TyAny; TyAny ], [ a ])
+ let to_int a = App (Expr.Floor_to_int, [], [ a ])
+ let equal a b = App (Expr.Equal, [ TyAny ], [ a; b ])
+ let le a b = App (Expr.Leq, [], [ a; b ])
+ let imply a b = App (Expr.Imply, [], [ a; b ])
+ let op op a b = App (op, [], [ a; b ])
+ let minus a = App (Expr.Minus, [], [ a ])
+ let x = 1
+ let y = 2
+
+ let filters : filter_quant list =
+ [
+ {
+ vars = [ x; y ];
+ filter =
+ (let x = Var x and y = Var y in
+ let morphism f =
+ equal (coercion (op f x y)) (op f (coercion x) (coercion y))
+ in
+ Choice
+ [
+ imply (equal (coercion x) (coercion y)) (equal x y);
+ imply (le x y) (le (coercion x) (coercion y));
+ (* imply (le x y) (le (to_int x) (to_int y)); *)
+ morphism Expr.Mul;
+ morphism Expr.Sub;
+ morphism Expr.Add;
+ ]);
+ };
+ {
+ vars = [ x ];
+ filter =
+ (let x = Var x in
+ Choice
+ [
+ equal (coercion (minus x)) (minus (coercion x));
+ equal (to_int (coercion x)) x;
+ ]);
+ };
+ ]
+
+ let register (q : Ground.ClosedQuantifier.s) = List.exists (match_ q) filters
+end
+
+let keep_relations =
+ Options.register ~pp:Fmt.bool "LRA.keep_relations"
+ Cmdliner.Arg.(
+ value & flag & info [ "lra-keep-relations-in-patterns" ] ~doc:"")
+
let init env =
Ground.register_converter env converter;
init_ty env;
- Check.init env
-
-let () =
- Colibri2_theories_quantifiers.Trigger.register_builtin_skipped_for_trigger
+ Check.init env;
+ Colibri2_theories_quantifiers.Info.Builtin_skipped_for_trigger.register env
(function
- | Expr.Leq | Expr.Geq | Expr.Lt | Expr.Gt | Expr.Equal -> true
- | _ -> false)
+ | Expr.Leq | Expr.Geq | Expr.Lt | Expr.Gt | Expr.Equal ->
+ not (Options.get env keep_relations)
+ | _ -> false);
+ Colibri2_theories_quantifiers.Quantifier.Quantifier_skipped.register env
+ Quantifier_skipped.register
diff --git a/src_colibri2/theories/LRA/simplex.ml b/src_colibri2/theories/LRA/simplex.ml
index cd582e8806071b0be468844e2e99c3fb623a01b8..65455483346ff7c34dc02f633541bf5a66eb6465 100644
--- a/src_colibri2/theories/LRA/simplex.ml
+++ b/src_colibri2/theories/LRA/simplex.ml
@@ -24,9 +24,6 @@ open Base
let comparisons = Datastructure.Push.create Node.pp "LRA.simplex.comparisons"
-let scheduled =
- Datastructure.Ref.create Base.Bool.pp "LRA.simplex.scheduled" false
-
let debug =
Debug.register_info_flag ~desc:"Reasoning about <= < in LRA" "simplex"
@@ -377,7 +374,6 @@ let update_domains d env =
let simplex (d : Egraph.wt) =
Debug.dprintf0 debug "[Simplex]";
Debug.incr stats_run;
- Datastructure.Ref.set scheduled d false;
let eqs, vars =
Datastructure.Push.fold comparisons d ~f:(make_equations d)
~init:(Polynome.H.create 10, Node.S.empty)
@@ -443,33 +439,53 @@ let simplex (d : Egraph.wt) =
let simplex d = Debug.add_time_during stats_time (fun () -> simplex d)
-module DaemonSimplex = struct
- let key =
- Events.Dem.create
- (module struct
- type t = unit
+module DaemonSimplex : sig
+ val enqueue : _ Egraph.t -> _ -> Events.enqueue
+ val enqueue' : _ Egraph.t -> unit
+end = struct
+ module DaemonSimplex = struct
+ let key =
+ Events.Dem.create
+ (module struct
+ type t = unit
- let name = "LRA.simplex"
- end)
+ let name = "LRA.simplex"
+ end)
- let enqueue d _ =
- if Datastructure.Ref.get scheduled d then (
- Debug.dprintf0 debug "[Scheduler] Simplex? No";
- Events.EnqAlready)
- else (
- Debug.dprintf0 debug "[Scheduler] Simplex? Yes";
- Datastructure.Ref.set scheduled d true;
- Events.EnqRun (key, (), None))
+ let scheduled =
+ Datastructure.Ref.create Base.Bool.pp "LRA.simplex.scheduled" false
- let delay = Events.Delayed_by 64
+ let enqueue_aux d =
+ if Datastructure.Ref.get scheduled d then (
+ Debug.dprintf0 debug "[Scheduler] Simplex? No";
+ false)
+ else (
+ Debug.dprintf0 debug "[Scheduler] Simplex? Yes";
+ Datastructure.Ref.set scheduled d true;
+ true)
- type runable = unit
+ let enqueue d _ =
+ if enqueue_aux d then Events.EnqRun (key, (), None) else Events.EnqAlready
- let print_runable = Unit.pp
- let run d () = simplex d
-end
+ let delay = Events.Delayed_by 64
+
+ type runable = unit
+
+ let print_runable = Unit.pp
-let () = Events.register (module DaemonSimplex)
+ let run d () =
+ Debug.dprintf0 debug "[Scheduler] Simplex? Run";
+ Datastructure.Ref.set scheduled d false;
+ simplex d
+ end
+
+ let () = Events.register (module DaemonSimplex)
+ let enqueue = DaemonSimplex.enqueue
+
+ let enqueue' d =
+ if DaemonSimplex.enqueue_aux d then
+ Events.new_pending_daemon d DaemonSimplex.key ()
+end
let ord_inv = function
| Expr.Lt -> Expr.Gt
@@ -543,7 +559,7 @@ let converter d (f : Ground.t) =
Events.attach_dom d n Dom_interval.dom DaemonSimplex.enqueue;
Datastructure.Push.push comparisons d n;
- Events.new_pending_daemon d DaemonSimplex.key ())
+ DaemonSimplex.enqueue' d)
| _ -> ()
let init env = Ground.register_converter env converter
diff --git a/src_colibri2/theories/quantifier/InvertedPath.ml b/src_colibri2/theories/quantifier/InvertedPath.ml
index a499059856b701b290f23e7f36dc25a781d03b87..ecac633da29b51cf28af3549187ca9c7286c96ec 100644
--- a/src_colibri2/theories/quantifier/InvertedPath.ml
+++ b/src_colibri2/theories/quantifier/InvertedPath.ml
@@ -30,6 +30,7 @@ open Common
type t' = {
triggers : Trigger.t list; (** triggers reached *)
+ callbacks : Callback.t list; (** generic triggers *)
matches : t Pattern.M.t;
(** Pattern to match the node against next top down *)
any_matches : t Pattern.M.t;
@@ -45,30 +46,60 @@ type t' = {
}
(** All the alternative path to continue in parallel *)
-and t = t' Context.Ref.t [@@deriving show]
+and t = { id : int; r : t' Context.Ref.t } [@@deriving show]
-let create creator =
- Context.Ref.create creator
+include (
+ Popop_stdlib.MakeMSH (struct
+ type nonrec t = t
+
+ let tag t = t.id
+ let pp = pp
+ end) :
+ Popop_stdlib.Datatype with type t := t)
+
+let create =
+ let get_counter, incr_counter = Util.get_counter () in
+ fun creator ->
+ incr_counter ();
{
- matches = Pattern.M.empty;
- any_matches = Pattern.M.empty;
- triggers = [];
- ups = F_Pos.M.empty;
+ id = get_counter ();
+ r =
+ Context.Ref.create creator
+ {
+ matches = Pattern.M.empty;
+ any_matches = Pattern.M.empty;
+ triggers = [];
+ callbacks = [];
+ ups = F_Pos.M.empty;
+ };
}
-let rec exec d acc substs n ip =
+let stat = Debug.register_stats_int "Quantifier.InvertedPath.exec"
+
+let rec exec d ((triggers, callbacks) as acc) substs n ip =
Debug.dprintf5 debug_full "[Quant] Exec: %a, %a[%i]" Node.pp n
Ground.Subst.S.pp substs
(Ground.Subst.S.cardinal substs);
+ Debug.incr stat;
(* pp ip; *)
if Ground.Subst.S.is_empty substs then acc
else
- let ip = Context.Ref.get ip in
- let acc =
+ let ip = Context.Ref.get ip.r in
+ let triggers =
List.fold_left
(fun acc tr ->
+ Debug.dprintf0 debug_full "[Quant] Trigger found";
Trigger.M.add_change (fun s -> s) Ground.Subst.S.union tr substs acc)
- acc ip.triggers
+ triggers ip.triggers
+ in
+ let callbacks =
+ List.fold_left
+ (fun acc call ->
+ Debug.dprintf2 debug_full "[Quant] Callback %a found" Callback.pp call;
+ Callback.M.add_change
+ (fun s -> s)
+ Ground.Subst.S.union call substs acc)
+ callbacks ip.callbacks
in
let acc =
Pattern.M.fold_left
@@ -76,7 +107,7 @@ let rec exec d acc substs n ip =
Debug.dprintf2 debug_full "[Quant] Exec match %a" Pattern.pp p;
let substs = Pattern.match_term d substs n p in
exec d acc substs n ip)
- acc ip.matches
+ (triggers, callbacks) ip.matches
in
let acc =
Pattern.M.fold_left
@@ -109,7 +140,8 @@ let rec exec d acc substs n ip =
Ground.S.fold_left (match_one_app pt) acc parents
in
let forall_fpos acc p ptl =
- Debug.dprintf2 debug_full "[Quant] Exec ups %a@." F_Pos.pp p;
+ Debug.dprintf4 debug_full "[Quant] Exec ups %a with %a@." F_Pos.pp p
+ Node.pp n;
let parents = F_Pos.M.find_def Ground.S.empty p info.parents in
List.fold_left (forall_triplets parents) acc ptl
in
@@ -119,7 +151,7 @@ let rec exec d acc substs n ip =
module HPC = Datastructure.Memo (PC)
module HPP = Datastructure.Memo (PP)
-module HPT = Datastructure.Memo (F_Pos)
+module HPT = Datastructure.Memo (PT)
module HPN = Datastructure.Memo (PN)
(** parent-child, wait for a subterm with the right application *)
@@ -128,43 +160,48 @@ let pc_ips = HPC.create Fmt.nop "Quantifier.pc" (fun c _ -> create c)
(** parent-parent, a variable appears two times *)
let pp_ips = HPP.create Fmt.nop "Quantifier.pp" (fun c _ -> create c)
-(** parent-type, wait for a type to match a variable *)
-let pt_ips =
- HPT.create Fmt.nop "Quantifier.pt" (fun c _ -> Context.Push.create c)
+(** parent-type, wait for a subterm with the right type (to match a variable) *)
+let pt_ips = HPT.create Fmt.nop "Quantifier.pt" (fun c _ -> create c)
(** parent-node, wait for a subterm with the right class *)
let pn_ips = HPN.create Fmt.nop "Quantifier.pn" (fun c _ -> create c)
let add_trigger pat ip =
- Context.Ref.set ip
+ Context.Ref.set ip.r
@@
- let ip = Context.Ref.get ip in
+ let ip = Context.Ref.get ip.r in
{ ip with triggers = pat :: ip.triggers }
+let add_callback pat ip =
+ Context.Ref.set ip.r
+ @@
+ let ip = Context.Ref.get ip.r in
+ { ip with callbacks = pat :: ip.callbacks }
+
let add_match pat ipr =
- let ip = Context.Ref.get ipr in
+ let ip = Context.Ref.get ipr.r in
match Pattern.M.find_opt pat ip.matches with
| Some ip' -> ip'
| None ->
- let ip' = create (Context.Ref.creator ipr) in
- Context.Ref.set ipr
+ let ip' = create (Context.Ref.creator ipr.r) in
+ Context.Ref.set ipr.r
@@ { ip with matches = Pattern.M.add pat ip' ip.matches };
ip'
let add_any_match pat ipr =
- let ip = Context.Ref.get ipr in
+ let ip = Context.Ref.get ipr.r in
match Pattern.M.find_opt pat ip.any_matches with
| Some ip' -> ip'
| None ->
- let ip' = create (Context.Ref.creator ipr) in
- Context.Ref.set ipr
+ let ip' = create (Context.Ref.creator ipr.r) in
+ Context.Ref.set ipr.r
@@ { ip with any_matches = Pattern.M.add pat ip' ip.any_matches };
ip'
let add_up f_pos tytl tl ipr =
- let ip = Context.Ref.get ipr in
- let ip' = create (Context.Ref.creator ipr) in
- Context.Ref.set ipr
+ let ip = Context.Ref.get ipr.r in
+ let ip' = create (Context.Ref.creator ipr.r) in
+ Context.Ref.set ipr.r
@@ {
ip with
ups =
@@ -173,7 +210,7 @@ let add_up f_pos tytl tl ipr =
};
ip'
-let insert_pattern d (trigger : Trigger.t) =
+let insert_pattern d (pattern : Pattern.t) pats add =
let rec aux (fp : F_Pos.t) pp_vars p =
match p with
| Pattern.Var v ->
@@ -182,8 +219,8 @@ let insert_pattern d (trigger : Trigger.t) =
List.filter (fun pp -> F_Pos.equal fp pp.PP.parent1) pairs
in
let ips = List.map (fun pp -> HPP.find pp_ips d pp) pairs in
- let ip = create (Egraph.context d) in
- Context.Push.push (HPT.find pt_ips d fp) (v.ty, ip);
+ let pt = PT.create fp v.ty in
+ let ip = HPT.find pt_ips d pt in
let ips = ip :: ips in
let ips = List.map (add_match p) ips in
ips
@@ -206,15 +243,36 @@ let insert_pattern d (trigger : Trigger.t) =
ips @ acc)
~init:[] tl
in
- let pp_vars = Pattern.get_pps trigger.pat [] in
- match trigger.pat with
+ let pp_vars = Pattern.get_pps pattern [] in
+ match pattern with
| Var _ | Node _ -> ()
| App (f, tytl, tl) ->
let ips = insert_children pp_vars f tytl tl in
let ips =
List.map
- (fun ip ->
- List.fold_left (fun ip p -> add_any_match p ip) ip trigger.pats)
+ (fun ip -> List.fold_left (fun ip p -> add_any_match p ip) ip pats)
ips
in
- List.iter (add_trigger trigger) ips
+ List.iter add ips
+
+let insert_trigger d (trigger : Trigger.t) =
+ insert_pattern d trigger.pat trigger.pats (add_trigger trigger)
+
+let add_callback d pat f =
+ let callback = Callback.mk d f pat in
+ Debug.dprintf4 Common.debug "Add callback %a for %a" Callback.pp callback
+ Pattern.pp pat;
+ Trigger.add_callback d callback;
+ insert_pattern d pat [] (add_callback callback);
+ let substs = Pattern.match_any_term d Pattern.init pat in
+ Callback.run d callback substs
+
+let add_trigger d t =
+ Trigger.add_trigger d t;
+ insert_trigger d t;
+ let substs =
+ List.fold_left
+ (fun acc pat -> Pattern.match_any_term d acc pat)
+ Pattern.init (t.pat :: t.pats)
+ in
+ Trigger.instantiate_many d t substs
diff --git a/src_colibri2/theories/quantifier/InvertedPath.mli b/src_colibri2/theories/quantifier/InvertedPath.mli
index 687935c730f2fb11fc7be6a21329177c8ee4e37d..ebe6d6a286dffc7f883e75e51480b49257916b6f 100644
--- a/src_colibri2/theories/quantifier/InvertedPath.mli
+++ b/src_colibri2/theories/quantifier/InvertedPath.mli
@@ -23,21 +23,24 @@ type t
of triggers. It allows to know which nodes merge can create new substitutions
for a pattern and how to find them. Cf Efficient E-matching + modifications *)
-val pp : t Fmt.t
+include Colibri2_popop_lib.Popop_stdlib.Datatype with type t := t
val exec :
_ Egraph.t ->
- Ground.Subst.S.t Trigger.M.t ->
+ Ground.Subst.S.t Trigger.M.t * Ground.Subst.S.t Callback.M.t ->
Ground.Subst.S.t ->
Node.t ->
t ->
- Ground.Subst.S.t Trigger.M.t
+ Ground.Subst.S.t Trigger.M.t * Ground.Subst.S.t Callback.M.t
(** [exec d acc substs n ip] adds to [acc] new substitutions to the triggers
that are obtained by the execution of the invertedpath *)
-val insert_pattern : _ Egraph.t -> Trigger.t -> unit
-(** [insert_pattern d tri] insert the pattern in the database of inverted path
- for all its subterms *)
+val add_callback :
+ Egraph.wt -> Pattern.t -> (Egraph.wt -> Ground.Subst.t -> unit) -> unit
+(** [add_callback d pat callback] wait for the pattern to be matched *)
+
+val add_trigger : Egraph.wt -> Trigger.t -> unit
+(** [add_trigger d trigger] wait for the trigger to be matched *)
module HPP : Datastructure.Memo with type key := PP.t
@@ -49,11 +52,11 @@ module HPC : Datastructure.Memo with type key := PC.t
val pc_ips : t HPC.t
(** The database of inverted path for each parent-child pairs *)
-module HPT : Datastructure.Memo with type key := F_Pos.t
+module HPT : Datastructure.Memo with type key := PT.t
-val pt_ips : (Expr.Ty.t * t) Context.Push.t HPT.t
-(** The database of inverted path for each parent-type, needed for polymorphic
- variables *)
+val pt_ips : t HPT.t
+(** The database of inverted path for each parent-type, needed for
+ variables present unique times *)
module HPN : Datastructure.Memo with type key := PN.t
diff --git a/src_colibri2/theories/quantifier/PT.ml b/src_colibri2/theories/quantifier/PT.ml
new file mode 100644
index 0000000000000000000000000000000000000000..cc46f12d4dfeb2dcda0dd2deb767b05418c7668e
--- /dev/null
+++ b/src_colibri2/theories/quantifier/PT.ml
@@ -0,0 +1,32 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+open Colibri2_popop_lib
+
+module T = struct
+ open! Base
+
+ type t = { parent : F_Pos.t; ty : Expr.Ty.t } [@@deriving show, ord, hash, eq]
+end
+
+include T
+include Popop_stdlib.MkDatatype (T)
+
+let create parent ty = { parent; ty }
diff --git a/src_colibri2/theories/quantifier/PT.mli b/src_colibri2/theories/quantifier/PT.mli
new file mode 100644
index 0000000000000000000000000000000000000000..4c053000c5b757a5a727e7398d568cabdbdc1c1b
--- /dev/null
+++ b/src_colibri2/theories/quantifier/PT.mli
@@ -0,0 +1,25 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+type t = private { parent : F_Pos.t; ty : Expr.Ty.t }
+
+include Colibri2_popop_lib.Popop_stdlib.Datatype with type t := t
+
+val create : F_Pos.t -> Expr.Ty.t -> t
diff --git a/src_colibri2/theories/quantifier/SubstTrie.ml b/src_colibri2/theories/quantifier/SubstTrie.ml
new file mode 100644
index 0000000000000000000000000000000000000000..4a809dba786adcd9b3d053d5e4171e8f88e98108
--- /dev/null
+++ b/src_colibri2/theories/quantifier/SubstTrie.ml
@@ -0,0 +1,64 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+module TTerm = Context.Trie (Node)
+(** Only for substitutions that have the same domain *)
+
+module TTy = Context.Trie (Ground.Ty)
+
+type 'a t = 'a TTy.t TTerm.t
+
+let create c = TTerm.create c
+
+let fold_of_term_map s : _ Context.fold =
+ {
+ fold =
+ (fun f acc -> Expr.Term.Var.M.fold_left (fun acc _ v -> f acc v) acc s);
+ }
+
+let fold_of_ty_map s : _ Context.fold =
+ {
+ fold = (fun f acc -> Expr.Ty.Var.M.fold_left (fun acc _ v -> f acc v) acc s);
+ }
+
+let find_and_add (t : bool t) (s : Ground.Subst.t) =
+ let tv =
+ TTerm.Fold.memo ~default:(fun c -> TTy.create c) t (fold_of_term_map s.term)
+ in
+ let not_set = ref false in
+ ignore
+ (TTy.Fold.memo
+ ~default:(fun _ ->
+ not_set := true;
+ true)
+ tv (fold_of_ty_map s.ty));
+ !not_set
+
+let find_def ~default (t : _ t) (s : Ground.Subst.t) =
+ let tv =
+ TTerm.Fold.memo ~default:(fun c -> TTy.create c) t (fold_of_term_map s.term)
+ in
+ TTy.Fold.find_def ~default:(fun _ -> default) tv (fold_of_ty_map s.ty)
+
+let set (t : _ t) (s : Ground.Subst.t) v =
+ let tv =
+ TTerm.Fold.memo ~default:(fun c -> TTy.create c) t (fold_of_term_map s.term)
+ in
+ TTy.Fold.set tv (fold_of_ty_map s.ty) v
diff --git a/src_colibri2/theories/quantifier/SubstTrie.mli b/src_colibri2/theories/quantifier/SubstTrie.mli
new file mode 100644
index 0000000000000000000000000000000000000000..353cdfee2f7471a3137ef62074b06816f77dfbe8
--- /dev/null
+++ b/src_colibri2/theories/quantifier/SubstTrie.mli
@@ -0,0 +1,34 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+type 'a t
+(** A map of substitution *)
+
+val create : Context.creator -> 'a t
+
+val find_and_add : bool t -> Ground.Subst.t -> bool
+(** Return if the substitution is in the set, and add it if it is not the case *)
+
+val find_def : default:'a -> 'a t -> Ground.Subst.t -> 'a
+(** Return the value associated to the substitution, or [default] if it is not
+ binded *)
+
+val set : 'a t -> Ground.Subst.t -> 'a -> unit
+(** Return set the associated value of the substitution *)
diff --git a/src_colibri2/theories/quantifier/callback.ml b/src_colibri2/theories/quantifier/callback.ml
new file mode 100644
index 0000000000000000000000000000000000000000..4b24893dd5005146b5422b1310e04b33d1119275
--- /dev/null
+++ b/src_colibri2/theories/quantifier/callback.ml
@@ -0,0 +1,44 @@
+open Common
+open Colibri2_popop_lib
+
+type t = {
+ id : int;
+ f : Egraph.wt -> Ground.Subst.t -> unit;
+ pat : Pattern.t;
+ already : bool SubstTrie.t;
+}
+
+let pattern t = t.pat
+
+include (
+ Popop_stdlib.MakeMSH (struct
+ type nonrec t = t
+
+ let tag t = t.id
+ let pp fmt t = Format.pp_print_int fmt t.id
+ end) :
+ Popop_stdlib.Datatype with type t := t)
+
+let mk =
+ let c = ref (-1) in
+ fun d f pat ->
+ incr c;
+ { id = !c; f; already = SubstTrie.create (Egraph.context d); pat }
+
+let run d t substs =
+ let substs =
+ Ground.Subst.S.fold_left
+ (fun acc s -> Ground.Subst.S.add (Ground.Subst.map_repr d s) acc)
+ Ground.Subst.S.empty substs
+ in
+ let iter s =
+ let already = SubstTrie.find_and_add t.already s in
+ if not already then t.f d s
+ in
+
+ Ground.Subst.S.iter iter substs
+
+let match_ d t n =
+ Debug.dprintf4 debug "[Quant] match %a %a" pp t Node.pp n;
+ let mvar = Pattern.match_term d Pattern.init n t.pat in
+ run d t mvar
diff --git a/src_colibri2/theories/quantifier/callback.mli b/src_colibri2/theories/quantifier/callback.mli
new file mode 100644
index 0000000000000000000000000000000000000000..c2948a6a6326459a5285f8f6accf9d29a4921b65
--- /dev/null
+++ b/src_colibri2/theories/quantifier/callback.mli
@@ -0,0 +1,9 @@
+include Colibri2_popop_lib.Popop_stdlib.Datatype
+
+val pattern : t -> Pattern.t
+val mk : Egraph.wt -> (Egraph.wt -> Ground.Subst.t -> unit) -> Pattern.t -> t
+val run : Egraph.wt -> t -> Ground.Subst.S.t -> unit
+
+val match_ : Egraph.wt -> t -> Node.t -> unit
+(** [match_ d t n] match the callback [t] with [n] and run [t]
+ with the resulting substitutions *)
diff --git a/src_colibri2/theories/quantifier/common.ml b/src_colibri2/theories/quantifier/common.ml
index 54a1fe8d8c6adf6859bd8ea9e892f2a6662abb0d..a5b985dccf00588d5bcc551b7bf8a7abfa0b3ebd 100644
--- a/src_colibri2/theories/quantifier/common.ml
+++ b/src_colibri2/theories/quantifier/common.ml
@@ -21,10 +21,22 @@
let debug =
Debug.register_info_flag ~desc:"Handling of quantifiers" "quantifiers"
+let debug_instantiation =
+ Debug.register_info_flag ~desc:"Handling of quantifiers"
+ "quantifiers.instantiations"
+
let debug_full =
Debug.register_flag ~desc:"Handling of quantifiers full" "quantifiers.full"
-let nb_instantiation = Debug.register_stats_int "instantiation"
-let nb_eager_instantiation = Debug.register_stats_int "eager_instantiation"
-let nb_delayed_instantiation = Debug.register_stats_int "delayed_instantiation"
-let nb_new_instantiation = Debug.register_stats_int "new_instantiation"
+let nb_instantiation = Debug.register_stats_int "Quantifier.instantiation"
+
+let nb_eager_instantiation =
+ Debug.register_stats_int "Quantifier.eager_instantiation"
+
+let nb_delayed_instantiation =
+ Debug.register_stats_int "Quantifier.delayed_instantiation"
+
+let nb_new_instantiation =
+ Debug.register_stats_int "Quantifier.new_instantiation"
+
+let stats_time = Debug.register_stats_time "Quantifier.time"
diff --git a/src_colibri2/theories/quantifier/definitions.ml b/src_colibri2/theories/quantifier/definitions.ml
new file mode 100644
index 0000000000000000000000000000000000000000..f74ab260be4ec121062db4596d325c5862afb8ae
--- /dev/null
+++ b/src_colibri2/theories/quantifier/definitions.ml
@@ -0,0 +1,54 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+open Colibri2_core
+open Colibri2_popop_lib
+
+let handler d (sym : Expr.Term.Const.t) tyl tvl body =
+ (* Check that it don't start with a builtin (can be changed) *)
+ if not (Info.Builtin_skipped_for_trigger.skipped d sym.builtin) then
+ let tys, tvs =
+ Expr.Term.free_vars (Expr.Ty.Var.S.empty, Expr.Term.Var.S.empty) body
+ in
+ if
+ List.for_all (fun v -> Expr.Ty.Var.S.mem v tys) tyl
+ && List.for_all (fun v -> Expr.Term.Var.S.mem v tvs) tvl
+ then
+ match Pattern.of_term_exn ~subst:Ground.Subst.empty body with
+ | exception Pattern.Unconvertible -> ()
+ | pat ->
+ Debug.dprintf2 Common.debug "[Def] Wait for folding %a"
+ Expr.Term.Const.pp sym;
+ InvertedPath.add_callback d pat (fun d subst ->
+ let t =
+ Ground.apply d sym
+ (List.map
+ (fun s -> Expr.Ty.Var.M.find_exn Impossible s subst.ty)
+ tyl)
+ (IArray.of_list_map
+ ~f:(fun s ->
+ Expr.Term.Var.M.find_exn Impossible s subst.term)
+ tvl)
+ in
+ Debug.dprintf2 Common.debug "Fold definition of %a" Ground.Term.pp
+ t;
+ Egraph.register d (Ground.node (Ground.index t)))
+
+let th_register d = Ground.Defs.add_handler d handler
diff --git a/src_colibri2/theories/quantifier/definitions.mli b/src_colibri2/theories/quantifier/definitions.mli
new file mode 100644
index 0000000000000000000000000000000000000000..8f115936a4b087bd606e6069f158e6354d85fe51
--- /dev/null
+++ b/src_colibri2/theories/quantifier/definitions.mli
@@ -0,0 +1,23 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+(** Try to fold definitions *)
+
+val th_register : Egraph.wt -> unit
diff --git a/src_colibri2/theories/quantifier/info.ml b/src_colibri2/theories/quantifier/info.ml
index ea4acbcd1bdf588f41d505ff8d9da537c512553b..7859026dc23b381af874d8b64586831d6648f3ed 100644
--- a/src_colibri2/theories/quantifier/info.ml
+++ b/src_colibri2/theories/quantifier/info.ml
@@ -24,6 +24,7 @@ open Colibri2_popop_lib
type t = {
parents : Ground.S.t F_Pos.M.t; (** parents *)
apps : Ground.S.t F.M.t; (** parent parent *)
+ ty : Ground.Ty.S.t; (** same as in ground but simplify incrementalism *)
}
[@@deriving show]
@@ -75,9 +76,11 @@ let merge d ~other ~repr info info' =
parents = congruence_closure d ~other ~repr info.parents info'.parents;
apps =
F.M.union (fun _ a b -> Some (Ground.S.union a b)) info.apps info'.apps;
+ ty = Ground.Ty.S.union info.ty info'.ty;
}
-let empty = { parents = F_Pos.M.empty; apps = F.M.empty }
+let empty =
+ { parents = F_Pos.M.empty; apps = F.M.empty; ty = Ground.Ty.S.empty }
let dom =
Dom.Kind.create
@@ -86,3 +89,22 @@ let dom =
let name = "Quantifier.info"
end)
+
+let tys d n =
+ Opt.get_def Ground.Ty.S.empty
+ @@
+ let open CCOption in
+ let+ info = Egraph.get_dom d dom n in
+ info.ty
+
+module Builtin_skipped_for_trigger = struct
+ let q = Datastructure.Push.create Fmt.nop "builtin_skipped_for_trigger"
+ let register d f = Datastructure.Push.push q d f
+
+ let skipped d builtin =
+ match builtin with
+ | Expr.And | Expr.Equal | Expr.Equiv | Expr.Or | Expr.Xor | Expr.Imply
+ | Expr.Ite | Expr.Neg ->
+ true
+ | _ -> Datastructure.Push.exists q d ~f:(fun p -> p builtin)
+end
diff --git a/src_colibri2/theories/quantifier/info.mli b/src_colibri2/theories/quantifier/info.mli
index cfe519e74a7ded3b87ee34004b64ff8d35924221..2deb6e80fe881aa7b835386f8088daca89207623 100644
--- a/src_colibri2/theories/quantifier/info.mli
+++ b/src_colibri2/theories/quantifier/info.mli
@@ -21,6 +21,7 @@
type t = {
parents : Ground.S.t F_Pos.M.t; (** parents *)
apps : Ground.S.t F.M.t; (** parent parent *)
+ ty : Ground.Ty.S.t; (** same as in ground but simplify incrementalism *)
}
[@@deriving show]
@@ -29,3 +30,14 @@ val merge : Egraph.wt -> other:Node.t -> repr:Node.t -> t -> t -> t
val empty : t
val dom : t Dom.Kind.t
+
+val tys : _ Egraph.t -> Node.t -> Ground.Ty.S.t
+(** Same as Ground.Tys but from Info.t *)
+
+module Builtin_skipped_for_trigger : sig
+ val register : _ Egraph.t -> (Expr.builtin -> bool) -> unit
+ (** The registered function tells when an application should be skipped when
+ looking for patterns in a term (top down) *)
+
+ val skipped : _ Egraph.t -> Expr.builtin -> bool
+end
diff --git a/src_colibri2/theories/quantifier/pattern.ml b/src_colibri2/theories/quantifier/pattern.ml
index 46489b54dfc1fd9b93ed8c62fcc2a9e267a7d2f9..6043ef820437188727b2f88ccd3c854de07fe128 100644
--- a/src_colibri2/theories/quantifier/pattern.ml
+++ b/src_colibri2/theories/quantifier/pattern.ml
@@ -72,14 +72,17 @@ let rec subst_aux_ty subst (ty : Expr.Ty.t) =
and subst_ty subst t =
if Expr.Ty.Var.M.is_empty subst then t else subst_aux_ty subst t
-let rec of_term ~subst (t : Expr.Term.t) =
+exception Unconvertible
+
+let rec of_term_exn ?(coercion = true) ~subst (t : Expr.Term.t) =
match t.term_descr with
| Var v -> (
match Expr.Term.Var.M.find v subst.Ground.Subst.term with
| exception Not_found -> Var { var = v; ty = subst_ty subst.ty v.id_ty }
| n -> Node n)
- | App ({ term_descr = Cst { builtin = Expr.Coercion; _ }; _ }, _, [ a ]) ->
- of_term ~subst a
+ | App ({ term_descr = Cst { builtin = Expr.Coercion; _ }; _ }, _, [ a ])
+ when not coercion ->
+ of_term_exn ~subst a
| App
( { term_descr = Cst { builtin = Expr.Ite; _ }; _ },
_,
@@ -89,16 +92,14 @@ let rec of_term ~subst (t : Expr.Term.t) =
{ term_descr = Cst { builtin = Expr.False; _ }; _ };
] ) ->
(* Why3 generates spurious (if v then true else false) *)
- of_term ~subst cond
+ of_term_exn ~subst cond
| App ({ term_descr = Cst f; _ }, tys, tl) ->
App
( f,
List.map (subst_ty subst.ty) tys,
- IArray.of_list_map ~f:(of_term ~subst) tl )
+ IArray.of_list_map ~f:(of_term_exn ~subst) tl )
| Cst f -> App (f, [], IArray.empty)
- | _ ->
- Fmt.epr "of_term: %a@." Expr.Term.pp t;
- (* absurd *) assert false
+ | _ -> raise Unconvertible
let init = Ground.Subst.S.singleton Ground.Subst.empty
@@ -136,9 +137,9 @@ let rec match_term d (substs : Ground.Subst.S.t) (n : Node.t) (p : t) :
Ground.Subst.S.union (match_ty substs ty v.ty) acc
in
Debug.dprintf4 debug_full "[Quant] Var: %a as type: %a." Node.pp n
- Ground.Ty.S.pp (Ground.tys d n);
+ Ground.Ty.S.pp (Info.tys d n);
let substs =
- Ground.Ty.S.fold_left match_ty Ground.Subst.S.empty (Ground.tys d n)
+ Ground.Ty.S.fold_left match_ty Ground.Subst.S.empty (Info.tys d n)
in
Ground.Subst.S.fold_left
(fun acc subst ->
@@ -156,7 +157,7 @@ let rec match_term d (substs : Ground.Subst.S.t) (n : Node.t) (p : t) :
Opt.get_def Ground.S.empty
@@
let open CCOption in
- let* info = Egraph.get_dom d Info.dom (Egraph.find_def d n) in
+ let* info = Egraph.get_dom d Info.dom n in
F.M.find_opt pf info.apps
in
Ground.S.fold_left
@@ -189,7 +190,7 @@ let rec check_term d (subst : Ground.Subst.t) (n : Node.t) (p : t) : bool =
Debug.dprintf4 debug "[Quant] check %a %a" pp p Node.pp n;
match p with
| Var v -> (
- Ground.Ty.S.exists (fun ty -> check_ty subst ty v.ty) (Ground.tys d n)
+ Ground.Ty.S.exists (fun ty -> check_ty subst ty v.ty) (Info.tys d n)
&&
match Expr.Term.Var.M.find v.var subst.term with
| exception Not_found -> false
@@ -223,49 +224,80 @@ let rec check_term_exists_exn d (subst : Ground.Subst.t) (p : t) : Node.S.t =
| n ->
if
(Ground.Ty.S.exists (fun ty -> check_ty subst ty v.ty))
- (Ground.tys d n)
+ (Info.tys d n)
then Node.S.singleton (Egraph.find_def d n)
else raise Not_found)
- | App (pf, ptyl, pargs) when IArray.is_empty pargs ->
- let g =
- Ground.apply d pf
- (List.map (Ground.Ty.convert subst.ty) ptyl)
- IArray.empty
- |> Ground.index |> Ground.node
- in
- if Egraph.is_registered d g then Node.S.singleton (Egraph.find d g)
- else raise Not_found
| App (pf, ptyl, pargs) ->
- let find_app pos n =
- Opt.get_def Ground.S.empty
- @@
- let open CCOption in
- let* info = Egraph.get_dom d Info.dom (Egraph.find_def d n) in
- F_Pos.M.find_opt { f = pf; pos } info.parents
- in
- let get_parents pos parg =
- let nodes = check_term_exists_exn d subst parg in
- let nodes =
- Node.S.fold_left
- (fun acc n ->
- Ground.S.fold_left
- (fun acc g ->
- if List.for_all2 (check_ty subst) (Ground.sem g).tyargs ptyl
- then Node.S.add (Ground.node g) acc
- else acc)
- acc (find_app pos n))
- Node.S.empty nodes
- in
- nodes
- in
- let nodes =
- IArray.foldi_non_empty_exn
- ~f:(fun i acc parg -> Node.S.inter acc (get_parents i parg))
- ~init:(get_parents 0) pargs
- in
+ let nodes_args = IArray.map ~f:(check_term_exists_exn d subst) pargs in
+ let nodes = find_existing_app d subst pf ptyl nodes_args in
if Node.S.is_empty nodes then raise Not_found else nodes
| Node n -> Node.S.singleton n
+and find_existing_app d subst pf ptyl nodes_args =
+ if IArray.is_empty nodes_args then
+ let g =
+ Ground.apply d pf
+ (List.map (Ground.Ty.convert subst.ty) ptyl)
+ IArray.empty
+ |> Ground.index |> Ground.node
+ in
+ if Egraph.is_registered d g then Node.S.singleton (Egraph.find d g)
+ else Node.S.empty
+ else
+ let find_app pos n =
+ Opt.get_def Ground.S.empty
+ @@
+ let open CCOption in
+ let app = { F_Pos.f = pf; pos } in
+ let* info = Egraph.get_dom d Info.dom n in
+ let+ parents = F_Pos.M.find_opt app info.parents in
+ (* Debug.dprintf6 debug "find_app %a: %a -- %a" F_Pos.pp app Node.pp n
+ * Ground.S.pp parents; *)
+ parents
+ in
+ let get_parents pos nodes =
+ let nodes =
+ Node.S.fold_left
+ (fun acc n ->
+ Ground.S.fold_left
+ (fun acc g ->
+ if List.for_all2 (check_ty subst) (Ground.sem g).tyargs ptyl
+ then Node.S.add (Ground.node g) acc
+ else acc)
+ acc (find_app pos n))
+ Node.S.empty nodes
+ in
+ nodes
+ in
+ (* let inter s1 s2 =
+ * (\* intersection modulo equality which keeps original node *\)
+ * Debug.dprintf4 debug "inter: %a -- %a" Node.S.pp s1 Node.S.pp s2;
+ * let cmp_with_repr n1 n2 =
+ * Node.compare (Egraph.find d n1) (Egraph.find d n2)
+ * in
+ * let s1 = Node.S.elements s1 |> List.sort_uniq cmp_with_repr in
+ * let s2 = Node.S.elements s2 |> List.sort_uniq cmp_with_repr in
+ * let rec inter l1 l2 acc =
+ * match (l1, l2) with
+ * | [], _ | _, [] -> acc
+ * | a :: l1', b :: l2' ->
+ * let c = cmp_with_repr a b in
+ * if c = 0 then inter l1' l2' (a :: acc)
+ * else if c < 0 then inter l1' l2 acc
+ * else inter l1 l2' acc
+ * in
+ * Node.S.of_list (inter s1 s2 [])
+ * in *)
+ let nodes =
+ IArray.foldi_non_empty_exn
+ ~f:(fun i acc nodes_arg ->
+ (* It is important to just use [Node.S.inter] because we want to do
+ [Ground.S.inter] so we should not take the representative *)
+ Node.S.inter acc (get_parents i nodes_arg))
+ ~init:(get_parents 0) nodes_args
+ in
+ nodes
+
let check_term_exists d (subst : Ground.Subst.t) (p : t) : Node.S.t =
try check_term_exists_exn d subst p with Not_found -> Node.S.empty
diff --git a/src_colibri2/theories/quantifier/pattern.mli b/src_colibri2/theories/quantifier/pattern.mli
index 252a806f9bd6150397d496145feb871fd3520fb1..d61d7a25c75e7483ff4cd45f26ef83d655bd2ceb 100644
--- a/src_colibri2/theories/quantifier/pattern.mli
+++ b/src_colibri2/theories/quantifier/pattern.mli
@@ -29,7 +29,9 @@ type t =
include Colibri2_popop_lib.Popop_stdlib.Datatype with type t := t
-val of_term : subst:Ground.Subst.t -> Expr.Term.t -> t
+exception Unconvertible
+
+val of_term_exn : ?coercion:bool -> subst:Ground.Subst.t -> Expr.Term.t -> t
val init : Ground.Subst.S.t
(** Singleton set with the empty substitution, can be used as initial value for
@@ -73,3 +75,13 @@ module EnvTy : Datastructure.Memo with type key := Ground.Ty.t
val env_node_by_ty : Node.t Context.Push.t EnvTy.t
(** The set of nodes sorted by their type. A node can have multiple types *)
+
+val find_existing_app :
+ 'a Egraph.t ->
+ Ground.Subst.t ->
+ F.t ->
+ Expr.ty list ->
+ Node.S.t IArray.t ->
+ Node.S.t
+(** [find_existing_app d s f tyl nodes_args] find existing application of [f] with one
+ of the nodes as arguments *)
diff --git a/src_colibri2/theories/quantifier/quantifier.ml b/src_colibri2/theories/quantifier/quantifier.ml
index 57eb1da18d84f35089b76cdb3d660711eef1433b..c07d92463c6e01107c5c125c67981405cb3f81cd 100644
--- a/src_colibri2/theories/quantifier/quantifier.ml
+++ b/src_colibri2/theories/quantifier/quantifier.ml
@@ -24,142 +24,278 @@ open Colibri2_popop_lib
open Colibri2_core
open Common
-let add_trigger d t =
- Trigger.add_trigger d t;
- InvertedPath.insert_pattern d t;
- let substs =
- List.fold_left
- (fun acc pat -> Pattern.match_any_term d acc pat)
- Pattern.init (t.pat :: t.pats)
- in
- Ground.Subst.S.iter (Trigger.instantiate d t) substs
+module Quantifier_skipped = struct
+ let q = Datastructure.Push.create Fmt.nop "quantifier_skipped"
+ let register d f = Datastructure.Push.push q d f
+ let skipped d builtin = Datastructure.Push.exists q d ~f:(fun p -> p builtin)
-let find_new_event d n (info : Info.t) n' (info' : Info.t) =
- Debug.dprintf8 debug "Find_new_event %a %a %a %a" Node.pp n Info.pp info
- Node.pp n' Info.pp info';
- let symmetric f acc na a nb b =
- if CCEqual.physical a b && Node.equal na nb then f acc na a nb b
- else f (f acc na a nb b) nb b na a
- in
- let do_pp pp ip acc =
- let aux acc _ info1 _ info2 =
- match
- ( F_Pos.M.find_opt pp.PP.parent1 info1.Info.parents,
- F_Pos.M.find_opt pp.PP.parent2 info2.Info.parents )
- with
- | Some _, Some _ ->
- (* Ground.S.fold_left
- * (fun acc n ->
- * let n = Ground.node n in
- * InvertedPath.exec d acc n ip)
- * acc parents *)
- Debug.dprintf4 debug_full "[Quant] PP %a found for %a" PP.pp pp
- Node.pp n;
- ip :: acc
- | _ -> acc
+ type filter_term =
+ | App of Expr.builtin * filter_ty list * filter_term list
+ | Var of int
+ | Choice of filter_term list
+ | Any
+
+ and filter_ty = TyApp of Expr.builtin * filter_ty list | TyAny
+ and filter_quant = { vars : int list; filter : filter_term }
+
+ let rec match_term env (filter : filter_term) (t : Expr.Term.t) =
+ match (filter, t) with
+ | ( App (fb, ftyl, ftl),
+ {
+ term_descr = App ({ term_descr = Cst { builtin = b; _ }; _ }, tyl, tl);
+ _;
+ } ) ->
+ Base.Poly.equal fb b
+ && List.for_all2 match_ty ftyl tyl
+ && List.for_all2 (match_term env) ftl tl
+ | Var v, { term_descr = Var v'; _ } ->
+ Expr.Term.Var.equal (Popop_stdlib.DInt.M.find v env) v'
+ | Choice filters, t -> List.exists (fun f -> match_term env f t) filters
+ | Any, _ -> true
+ | _ -> false
+
+ and match_ty (filter : filter_ty) (ty : Expr.Ty.t) =
+ match (filter, ty) with
+ | TyApp (fb, ftyl), { ty_descr = TyApp ({ builtin = b; _ }, tyl); _ } ->
+ Base.Poly.equal fb b && List.for_all2 match_ty ftyl tyl
+ | TyAny, _ -> true
+ | _ -> false
+
+ and match_ (quant : Ground.ClosedQuantifier.s) filter =
+ Base.List.is_empty quant.ty_vars
+ &&
+ match
+ Base.List.fold2 ~init:Popop_stdlib.DInt.M.empty filter.vars
+ quant.term_vars ~f:(fun acc i v ->
+ Popop_stdlib.DInt.M.add_new Impossible i v acc)
+ with
+ | Unequal_lengths -> false
+ | Ok env -> match_term env filter.filter quant.body
+end
+
+module Find_new_event = struct
+ let two d n (info : Info.t) n' (info' : Info.t) acc =
+ Debug.dprintf8 debug "Find_new_event %a %a %a %a" Node.pp n Info.pp info
+ Node.pp n' Info.pp info';
+ let symmetric f acc na a nb b =
+ if CCEqual.physical a b && Node.equal na nb then f acc na a nb b
+ else f (f acc na a nb b) nb b na a
in
- symmetric aux acc n info n' info'
- in
- let do_pc pc ip acc =
- let aux acc _ info1 _ info2 =
- match
- ( F_Pos.M.find_opt pc.PC.parent info1.Info.parents,
- F.M.find_opt pc.PC.child info2.Info.apps )
- with
- | Some _, Some _ ->
- (* Ground.S.fold_left
- * (fun acc n ->
- * let n = Ground.node n in
- * InvertedPath.exec d acc n ip)
- * acc parents *)
- Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PC.pp pc
- Node.pp n;
- ip :: acc
- | _ -> acc
+ let do_pp pp ip acc =
+ let aux acc _ info1 _ info2 =
+ match
+ ( F_Pos.M.find_opt pp.PP.parent1 info1.Info.parents,
+ F_Pos.M.find_opt pp.PP.parent2 info2.Info.parents )
+ with
+ | Some _, Some _ ->
+ (* Ground.S.fold_left
+ * (fun acc n ->
+ * let n = Ground.node n in
+ * InvertedPath.exec d acc n ip)
+ * acc parents *)
+ Debug.dprintf4 debug_full "[Quant] PP %a found for %a" PP.pp pp
+ Node.pp n;
+ ip :: acc
+ | _ -> acc
+ in
+ symmetric aux acc n info n' info'
in
- symmetric aux acc n info n' info'
- in
- (* parent node *)
- let do_pn pn ip acc =
- let aux acc n info1 n' _ =
- if Egraph.is_equal d n' pn.PN.node then
- match F_Pos.M.find_opt pn.PN.parent info1.Info.parents with
- | Some _ ->
- Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PN.pp pn
+ let do_pc pc ip acc =
+ let aux acc _ info1 _ info2 =
+ match
+ ( F_Pos.M.find_opt pc.PC.parent info1.Info.parents,
+ F.M.find_opt pc.PC.child info2.Info.apps )
+ with
+ | Some _, Some _ ->
+ (* Ground.S.fold_left
+ * (fun acc n ->
+ * let n = Ground.node n in
+ * InvertedPath.exec d acc n ip)
+ * acc parents *)
+ Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PC.pp pc
Node.pp n;
ip :: acc
| _ -> acc
- else acc
+ in
+ symmetric aux acc n info n' info'
in
- symmetric aux acc n info n' info'
- in
- (* parent type *)
- let do_pt f_pos q acc =
- let aux acc n info1 n' _ =
- match F_Pos.M.find_opt f_pos info1.Info.parents with
- | Some _ ->
- Context.Push.fold
- (fun acc (vty, ip) ->
- let substs_by n0 =
- let match_ty (acc : Ground.Subst.S.t) ty : Ground.Subst.S.t =
- Ground.Subst.S.union
- (Pattern.match_ty Pattern.init ty vty)
- acc
- in
- let substs =
- Ground.Ty.S.fold_left match_ty Pattern.init (Ground.tys d n0)
- in
- substs
- in
- let substs2 = substs_by n in
- let substs1 =
- if Node.equal n n' then Ground.Subst.S.empty else substs_by n'
+ (* parent node *)
+ let do_pn pn ip acc =
+ let aux acc n info1 n' _ =
+ if Egraph.is_equal d n' pn.PN.node then
+ match F_Pos.M.find_opt pn.PN.parent info1.Info.parents with
+ | Some _ ->
+ Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PN.pp pn
+ Node.pp n;
+ ip :: acc
+ | _ -> acc
+ else acc
+ in
+ symmetric aux acc n info n' info'
+ in
+ (* parent type *)
+ let do_pt { PT.parent = f_pos; ty = vty } ip acc =
+ let aux acc n (info1 : Info.t) _ (info2 : Info.t) =
+ match F_Pos.M.mem f_pos info1.parents with
+ | true ->
+ let tys = Ground.Ty.S.diff info2.ty info1.ty in
+ if Ground.Ty.S.is_empty tys then acc
+ else
+ let no_match ty : bool =
+ Ground.Subst.S.is_empty (Pattern.match_ty Pattern.init ty vty)
in
- if Ground.Subst.S.subset substs2 substs1 then acc
+ if Ground.Ty.S.for_all no_match tys then acc
else (
Debug.dprintf6 debug_full "[Quant] PT %a %a found for %a"
F_Pos.pp f_pos Expr.Ty.pp vty Node.pp n;
- ip :: acc))
- acc q
- | None -> acc
+ ip :: acc)
+ | _ -> acc
+ in
+ symmetric aux acc n info n' info'
in
- symmetric aux acc n info n' info'
- in
- let acc = [] in
- let acc = InvertedPath.HPP.fold do_pp InvertedPath.pp_ips d acc in
- let acc = InvertedPath.HPC.fold do_pc InvertedPath.pc_ips d acc in
- let acc = InvertedPath.HPT.fold do_pt InvertedPath.pt_ips d acc in
- let acc = InvertedPath.HPN.fold do_pn InvertedPath.pn_ips d acc in
- acc
+ let acc = InvertedPath.HPP.fold do_pp InvertedPath.pp_ips d acc in
+ let acc = InvertedPath.HPC.fold do_pc InvertedPath.pc_ips d acc in
+ let acc = InvertedPath.HPT.fold do_pt InvertedPath.pt_ips d acc in
+ let acc = InvertedPath.HPN.fold do_pn InvertedPath.pn_ips d acc in
+ acc
-let process_inverted_path d n acc =
- let acc =
- List.fold_left
- (fun acc ip -> InvertedPath.exec d acc Pattern.init n ip)
- Trigger.M.empty acc
- in
- Trigger.M.iter
- (fun tri substs -> Ground.Subst.S.iter (Trigger.instantiate d tri) substs)
+ let one d n (info : Info.t) acc =
+ Debug.dprintf4 debug "Find_new_event %a %a" Node.pp n Info.pp info;
+ let do_pp pp ip acc =
+ let aux acc _ info1 =
+ match
+ ( F_Pos.M.find_opt pp.PP.parent1 info1.Info.parents,
+ F_Pos.M.find_opt pp.PP.parent2 info1.Info.parents )
+ with
+ | Some _, Some _ ->
+ (* Ground.S.fold_left
+ * (fun acc n ->
+ * let n = Ground.node n in
+ * InvertedPath.exec d acc n ip)
+ * acc parents *)
+ Debug.dprintf4 debug_full "[Quant] PP %a found for %a" PP.pp pp
+ Node.pp n;
+ ip :: acc
+ | _ -> acc
+ in
+ aux acc n info
+ in
+ let do_pc pc ip acc =
+ let aux acc _ info1 =
+ match
+ ( F_Pos.M.find_opt pc.PC.parent info1.Info.parents,
+ F.M.find_opt pc.PC.child info1.Info.apps )
+ with
+ | Some _, Some _ ->
+ (* Ground.S.fold_left
+ * (fun acc n ->
+ * let n = Ground.node n in
+ * InvertedPath.exec d acc n ip)
+ * acc parents *)
+ Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PC.pp pc
+ Node.pp n;
+ ip :: acc
+ | _ -> acc
+ in
+ aux acc n info
+ in
+ (* parent node *)
+ let do_pn pn ip acc =
+ let aux acc n info1 =
+ if Egraph.is_equal d n pn.PN.node then
+ match F_Pos.M.find_opt pn.PN.parent info1.Info.parents with
+ | Some _ ->
+ Debug.dprintf4 debug_full "[Quant] PC %a found for %a" PN.pp pn
+ Node.pp n;
+ ip :: acc
+ | _ -> acc
+ else acc
+ in
+ aux acc n info
+ in
+ (* parent type *)
+ let do_pt { PT.parent = f_pos; ty = vty } ip acc =
+ let aux acc n info1 =
+ match F_Pos.M.find_opt f_pos info1.Info.parents with
+ | Some _ ->
+ let no_match ty : bool =
+ Ground.Subst.S.is_empty (Pattern.match_ty Pattern.init ty vty)
+ in
+ if Ground.Ty.S.for_all no_match info1.ty then acc
+ else (
+ Debug.dprintf6 debug_full "[Quant] PT %a %a found for %a" F_Pos.pp
+ f_pos Expr.Ty.pp vty Node.pp n;
+ ip :: acc)
+ | None -> acc
+ in
+ aux acc n info
+ in
+ let acc = InvertedPath.HPP.fold do_pp InvertedPath.pp_ips d acc in
+ let acc = InvertedPath.HPC.fold do_pc InvertedPath.pc_ips d acc in
+ let acc = InvertedPath.HPT.fold do_pt InvertedPath.pt_ips d acc in
+ let acc = InvertedPath.HPN.fold do_pn InvertedPath.pn_ips d acc in
acc
+end
-module Delayed_find_new_event = struct
- let key =
- Events.Dem.create
- (module struct
- type t = Node.t * InvertedPath.t list
+module Delayed_find_new_event : sig
+ val enqueue : _ Egraph.t -> Node.t -> InvertedPath.t list -> unit
+end = struct
+ module Delayed_find_new_event = struct
+ let key =
+ Events.Dem.create
+ (module struct
+ type t = unit
- let name = "Quantifier.new_event"
- end)
+ let name = "Quantifier.new_event"
+ end)
- let delay = Events.Delayed_by 10
+ let delay = Events.Delayed_by 15
- type runable = Node.t * InvertedPath.t list [@@deriving show]
+ type runable = unit
- let print_runable = pp_runable
- let run d (n, ips) = process_inverted_path d n ips
-end
+ let print_runable = Unit.pp
-let () = Events.register (module Delayed_find_new_event)
+ let scheduled =
+ Datastructure.Ref.create Fmt.nop "Quant.delayed_find_new_event"
+ Node.M.empty
+
+ let run d () =
+ let run () =
+ let m = Datastructure.Ref.get scheduled d in
+ Datastructure.Ref.set scheduled d Node.M.empty;
+ let triggers, callbacks =
+ Node.M.fold_left
+ (fun acc n ips ->
+ InvertedPath.S.fold_left
+ (fun acc ip -> InvertedPath.exec d acc Pattern.init n ip)
+ acc ips)
+ (Trigger.M.empty, Callback.M.empty)
+ m
+ in
+ Trigger.M.iter
+ (fun tri substs -> Trigger.instantiate_many d tri substs)
+ triggers;
+ Callback.M.iter
+ (fun callback substs -> Callback.run d callback substs)
+ callbacks
+ in
+ Debug.add_time_during stats_time run
+ end
+
+ let () = Events.register (module Delayed_find_new_event)
+
+ let enqueue d n l =
+ if not (Base.List.is_empty l) then (
+ let m = Datastructure.Ref.get Delayed_find_new_event.scheduled d in
+ if Node.M.is_empty m then
+ Events.new_pending_daemon d Delayed_find_new_event.key ();
+ let m =
+ Node.M.add_change InvertedPath.S.of_list
+ (fun l v -> List.fold_right InvertedPath.S.add l v)
+ n l m
+ in
+ Datastructure.Ref.set Delayed_find_new_event.scheduled d m)
+end
let () =
Dom.register
@@ -187,9 +323,9 @@ let () =
let info = Info.merge d ~other ~repr info0 info1 in
Egraph.set_dom d Info.dom cl0 info;
Egraph.set_dom d Info.dom cl1 info;
- let ips = find_new_event d cl0 info0 cl1 info1 in
- if not (Base.List.is_empty ips) then
- Events.new_pending_daemon d Delayed_find_new_event.key (repr, ips)
+ Debug.add_time_during stats_time (fun () ->
+ let ips = Find_new_event.two d cl0 info0 cl1 info1 [] in
+ Delayed_find_new_event.enqueue d repr ips)
end)
let skolemize d (e : Ground.ClosedQuantifier.s) =
@@ -217,10 +353,14 @@ let attach d th =
Debug.dprintf2 debug "[Quant] Skolemize %a" Ground.ClosedQuantifier.pp
th;
Egraph.merge d (skolemize d e) n
+ | ({ binder = Exists; _ } as e), false
+ | ({ binder = Forall; _ } as e), true
+ when Quantifier_skipped.skipped d e ->
+ Debug.dprintf2 debug "[Quant] Skip %a" Ground.ClosedQuantifier.pp th
| { binder = Exists; _ }, false | { binder = Forall; _ }, true ->
let triggers =
- match Trigger.get_user_triggers th with
- | [] -> Trigger.compute_top_triggers th
+ match Trigger.get_user_triggers d th with
+ | [] -> Trigger.compute_top_triggers d th
| triggers -> triggers
in
Debug.dprintf4 debug "[Quant] For %a adds %a"
@@ -231,7 +371,7 @@ let attach d th =
(fun t -> t.Trigger.pats)
(list ~sep:comma Pattern.pp)))
triggers;
- List.iter (add_trigger d) triggers
+ List.iter (InvertedPath.add_trigger d) triggers
(* Todo match with current terms *))
let quantifier_registered d th =
@@ -271,11 +411,13 @@ let add_info_on_ground_terms d thg =
match Egraph.get_dom d Info.dom repr with
| None ->
Egraph.set_dom d Info.dom repr info;
- process_inverted_path d repr (find_new_event d repr info repr info)
+ Delayed_find_new_event.enqueue d repr
+ (Find_new_event.one d repr info [])
| Some info' ->
Egraph.set_dom d Info.dom repr (Info.merge d ~repr ~other info info');
- process_inverted_path d repr (find_new_event d repr info repr info);
- process_inverted_path d repr (find_new_event d repr info repr info')
+ Find_new_event.one d repr info []
+ |> Find_new_event.two d repr info repr info'
+ |> Delayed_find_new_event.enqueue d repr
in
let add_pc pos n =
merge_info n
@@ -286,20 +428,29 @@ let add_info_on_ground_terms d thg =
in
IArray.iteri ~f:add_pc g.args;
merge_info res
- { Info.empty with apps = F.M.singleton g.app (Ground.S.singleton thg) };
+ {
+ Info.empty with
+ apps = F.M.singleton g.app (Ground.S.singleton thg);
+ ty = Ground.Ty.S.singleton g.ty;
+ };
Context.Push.push (F.EnvApps.find Pattern.env_ground_by_apps d g.app) thg;
Context.Push.push (Pattern.EnvTy.find Pattern.env_node_by_ty d g.ty) res;
(* Try pattern from the start *)
let trgs = F.EnvApps.find Trigger.env_tri_by_apps d g.app in
- Context.Push.iter (fun trg -> Trigger.match_ d trg res) trgs
+ Context.Push.iter
+ (function
+ | Trigger.Trigger trg -> Trigger.match_ d trg res
+ | Trigger.Callback call -> Callback.match_ d call res)
+ trgs
let th_register d =
(* let delay = Events.Delayed_by 10 in *)
Daemon.attach_reg_sem d Ground.ClosedQuantifier.key quantifier_registered;
Ground.register_converter d (fun d g ->
- if application_useless d g then
- Debug.dprintf2 debug "[Info] %a is redundant" Ground.pp g
- else add_info_on_ground_terms d g);
+ Debug.add_time_during stats_time (fun () ->
+ if application_useless d g then
+ Debug.dprintf2 debug "[Info] %a is redundant" Ground.pp g
+ else add_info_on_ground_terms d g));
Interp.Register.check_closed_quantifier d (fun d g ->
let n = Ground.ClosedQuantifier.node g in
let unknown =
@@ -307,6 +458,7 @@ let th_register d =
| Forall -> Boolean.is_true d n
| Exists -> Boolean.is_false d n
in
- if unknown then Unknown else Right)
+ if unknown then Unknown else Right);
+ Definitions.th_register d
let () = Init.add_default_theory th_register
diff --git a/src_colibri2/theories/quantifier/quantifier.mli b/src_colibri2/theories/quantifier/quantifier.mli
index ea1e233032147771b03480dede93c545ff84a82a..e1791146f3e4b136de2319fbfaa74eef456124be 100644
--- a/src_colibri2/theories/quantifier/quantifier.mli
+++ b/src_colibri2/theories/quantifier/quantifier.mli
@@ -19,3 +19,18 @@
(*************************************************************************)
val th_register : Egraph.wt -> unit
+
+module Quantifier_skipped : sig
+ val register : _ Egraph.t -> (Ground.ClosedQuantifier.s -> bool) -> unit
+
+ type filter_term =
+ | App of Expr.builtin * filter_ty list * filter_term list
+ | Var of int
+ | Choice of filter_term list
+ | Any
+
+ and filter_ty = TyApp of Expr.builtin * filter_ty list | TyAny
+ and filter_quant = { vars : int list; filter : filter_term }
+
+ val match_ : Ground.ClosedQuantifier.s -> filter_quant -> bool
+end
diff --git a/src_colibri2/theories/quantifier/subst.ml b/src_colibri2/theories/quantifier/subst.ml
new file mode 100644
index 0000000000000000000000000000000000000000..96990e7f243d254013983ad484d697995025afd6
--- /dev/null
+++ b/src_colibri2/theories/quantifier/subst.ml
@@ -0,0 +1,276 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+open Colibri2_popop_lib
+
+(** Copied from ground.ml *)
+
+let debug = Debug.register_flag ~desc:"" "Quant.Subst"
+
+type mode = { context : bool; avoid_new_term : bool }
+
+exception New_term
+
+let of_node mode d n =
+ if mode.avoid_new_term && not (Egraph.is_registered d n) then raise New_term;
+ Node.S.singleton n
+
+(**
+ subst_old: substitution applied on top of the quantification
+ subst_new: substitution to substitute the variable quantified
+ subst: the disjoint merge of the two
+ *)
+
+let rec convert_and_iter mode d (subst_old : Ground.Subst.t)
+ (subst_new : Ground.Subst.t) subst (t : Expr.Term.t) :
+ Node.S.t * bool (* with freevars *) =
+ match t.term_descr with
+ | Var v -> (
+ Debug.dprintf2 debug "ci var %a" Expr.Term.pp t;
+ match
+ ( Expr.Term.Var.M.find_opt v subst_old.term,
+ Expr.Term.Var.M.find_opt v subst_new.term )
+ with
+ | None, None -> invalid_arg (Fmt.str "Not_ground: %a" Expr.Term.Var.pp v)
+ | Some n1, Some n2 ->
+ invalid_arg
+ (Fmt.str "convert_iter: duplicate variable %a: %a -- %a"
+ Expr.Term.Var.pp v Node.pp n1 Node.pp n2)
+ | None, Some n -> (Node.S.singleton n, true)
+ | Some n, None -> (Node.S.singleton n, false))
+ | App
+ ( { term_descr = Cst { builtin = Expr.Ite; _ }; _ },
+ _,
+ [
+ cond;
+ { term_descr = Cst { builtin = Expr.True; _ }; _ };
+ { term_descr = Cst { builtin = Expr.False; _ }; _ };
+ ] ) ->
+ (* Why3 generates spurious (if v then true else false) *)
+ convert_and_iter mode d subst_old subst_new subst cond
+ | App (({ term_descr = Cst cst; _ } as f), tyargs, args) ->
+ Debug.dprintf2 debug "ci app cst %a" Expr.Term.pp t;
+ let with_freevars = ref false in
+ let args =
+ IArray.of_list_map
+ ~f:(fun arg ->
+ let arg', wf =
+ convert_and_iter mode d subst_old subst_new subst arg
+ in
+ Debug.dprintf3 debug "fv %a: %b" Expr.Term.pp arg wf;
+ with_freevars := !with_freevars || wf;
+ arg')
+ args
+ in
+ let nodes = Pattern.find_existing_app d subst cst tyargs args in
+ Debug.dprintf6 debug "find_existing_app: %a[%a] -> %a" F.pp cst
+ (IArray.pp Node.S.pp) args Node.S.pp nodes;
+ let mode =
+ if mode.context then
+ if Info.Builtin_skipped_for_trigger.skipped d cst.builtin then mode
+ else { mode with context = false }
+ else mode
+ in
+ if Node.S.is_empty nodes then (
+ if !with_freevars && mode.avoid_new_term && not mode.context then (
+ Debug.dprintf2 debug "new term cst: %a" Expr.Term.pp t;
+ raise New_term);
+ let args = IArray.map ~f:Node.S.choose args in
+ let n = Ground.convert_one_app subst d f tyargs args t.term_ty in
+ (Node.S.singleton n, !with_freevars))
+ else (nodes, !with_freevars)
+ | App (f, tyargs, args) ->
+ Debug.dprintf2 debug "ci app %a" Expr.Term.pp t;
+ if mode.avoid_new_term then (
+ Debug.dprintf2 debug "new term generic: %a" Expr.Term.pp t;
+ raise New_term);
+ let with_freevars = ref false in
+ let args =
+ IArray.of_list_map
+ ~f:(fun arg ->
+ let arg, wf =
+ convert_and_iter mode d subst_old subst_new subst arg
+ in
+ with_freevars := !with_freevars || wf;
+ arg)
+ args
+ in
+ let args = IArray.map ~f:Node.S.choose args in
+ let n = Ground.convert_one_app subst d f tyargs args t.term_ty in
+ (Node.S.singleton n, !with_freevars)
+ | Cst f ->
+ Debug.dprintf2 debug "ci cst %a" Expr.Term.pp t;
+ (* even if it could create a new term, it will create it only once (global term) *)
+ (Node.S.singleton (Ground.convert_one_cst subst d f), false)
+ | Expr.Binder (((Exists _ | Forall _ | Lambda _) as b), body) ->
+ ( Ground.convert_one_binder subst d b body t.term_ty |> of_node mode d,
+ true )
+ | Expr.Binder (Let_seq l, body) ->
+ let subst_old, subst_new, subst =
+ List.fold_left
+ (fun (subst_old, subst_new, subst) (v, t) ->
+ let n, fv =
+ convert_and_iter
+ { mode with context = false }
+ d subst_old subst_new subst t
+ in
+ let n = Node.S.choose n in
+ let add (s : Ground.Subst.t) =
+ { s with term = Expr.Term.Var.M.add v n s.term }
+ in
+ if fv then (subst_old, add subst_new, add subst)
+ else (add subst_old, subst_new, add subst))
+ (subst_old, subst_new, subst)
+ l
+ in
+ convert_and_iter mode d subst_old subst_new subst body
+ | Expr.Binder (Let_par l, body) ->
+ let subst_old, subst_new, subst =
+ List.fold_left
+ (fun (subst_old', subst_new', subst') (v, t) ->
+ let n, fv =
+ convert_and_iter
+ { mode with context = false }
+ d subst_old subst_new subst t
+ in
+ let n = Node.S.choose n in
+ let add (s : Ground.Subst.t) =
+ { s with term = Expr.Term.Var.M.add v n s.term }
+ in
+ if fv then (subst_old', add subst_new', add subst')
+ else (add subst_old', subst_new', add subst'))
+ (subst_old, subst_new, subst)
+ l
+ in
+ convert_and_iter mode d subst_old subst_new subst body
+ | Expr.Match (_, _) -> invalid_arg "match from dolmen not implemented"
+(* TODO convert to one multitest like
+ the match of why3 and projection *)
+
+let rec check_context_aux d (subst_old : Ground.Subst.t)
+ (subst_new : Ground.Subst.t) (subst : Ground.Subst.t) (t : Expr.Term.t) =
+ match t.term_descr with
+ | Var _ -> true
+ | App
+ ( { term_descr = Cst { builtin = Expr.Ite; _ }; _ },
+ _,
+ [
+ cond;
+ { term_descr = Cst { builtin = Expr.True; _ }; _ };
+ { term_descr = Cst { builtin = Expr.False; _ }; _ };
+ ] ) ->
+ (* Why3 generates spurious (if v then true else false) *)
+ check_context d subst_old subst_new subst cond
+ | App ({ term_descr = Cst cst; _ }, _, args) ->
+ if Info.Builtin_skipped_for_trigger.skipped d cst.builtin then
+ List.for_all (check_context d subst_old subst_new subst) args
+ else
+ let n, _ =
+ convert_and_iter
+ { context = true; avoid_new_term = true }
+ d subst_old subst_new subst t
+ in
+ not (Node.S.is_empty n)
+ | App _ -> false
+ | Cst _ ->
+ true
+ (* Ground.convert_one_cst subst d f
+ * |> of_node { context = true; avoid_new_term = true } d
+ * |> Node.S.is_empty |> not *)
+ | Expr.Binder (((Exists _ | Forall _ | Lambda _) as b), body) ->
+ Ground.convert_one_binder subst d b body t.term_ty
+ |> of_node { context = true; avoid_new_term = true } d
+ |> Node.S.is_empty |> not
+ | Expr.Binder (Let_seq l, body) ->
+ let subst_old, subst_new, subst =
+ List.fold_left
+ (fun (subst_old, subst_new, subst) (v, t) ->
+ let n, fv =
+ convert_and_iter
+ { context = false; avoid_new_term = true }
+ d subst_old subst_new subst t
+ in
+ let n = Node.S.choose n in
+ let add (s : Ground.Subst.t) =
+ { s with term = Expr.Term.Var.M.add v n s.term }
+ in
+ if fv then (subst_old, add subst_new, add subst)
+ else (add subst_old, subst_new, subst))
+ (subst_old, subst_new, subst)
+ l
+ in
+ check_context d subst_old subst_new subst body
+ | Expr.Binder (Let_par l, body) ->
+ let subst_old, subst_new, subst =
+ List.fold_left
+ (fun (subst_old', subst_new', subst') (v, t) ->
+ let n, fv =
+ convert_and_iter
+ { context = false; avoid_new_term = true }
+ d subst_old subst_new subst t
+ in
+ let n = Node.S.choose n in
+ let add (s : Ground.Subst.t) =
+ { s with term = Expr.Term.Var.M.add v n s.term }
+ in
+ if fv then (subst_old', add subst_new', add subst')
+ else (add subst_old', subst_new', subst'))
+ (subst_old, subst_new, subst)
+ l
+ in
+ check_context d subst_old subst_new subst body
+ | Expr.Match (_, _) -> invalid_arg "match from dolmen not implemented"
+(* TODO convert to one multitest like
+ the match of why3 and projection *)
+
+and check_context d subst_old subst_new subst t =
+ let c = check_context_aux d subst_old subst_new subst t in
+ if not c then Debug.dprintf2 debug "check false: %a" Expr.Term.pp t;
+ c
+
+let convert ~subst_old ~subst_new d t =
+ let subst = Ground.Subst.distinct_union subst_old subst_new in
+ try
+ let n, _ =
+ convert_and_iter
+ { context = true; avoid_new_term = false }
+ d subst_old subst_new subst t
+ in
+ Node.S.choose n
+ with New_term -> assert false
+
+let convert_avoid_new_terms ~subst_old ~subst_new d t =
+ let subst = Ground.Subst.distinct_union subst_old subst_new in
+ let b =
+ try check_context d subst_old subst_new subst t
+ with New_term ->
+ Debug.dprintf0 debug "check_context";
+ false
+ in
+ if b then
+ try
+ let n, _ =
+ convert_and_iter
+ { context = true; avoid_new_term = true }
+ d subst_old subst_new subst t
+ in
+ Some (Node.S.choose n)
+ with New_term -> None
+ else None
diff --git a/src_colibri2/theories/quantifier/subst.mli b/src_colibri2/theories/quantifier/subst.mli
new file mode 100644
index 0000000000000000000000000000000000000000..e9b262c70dd33c5d2057b0408b30b4ccf39e99e5
--- /dev/null
+++ b/src_colibri2/theories/quantifier/subst.mli
@@ -0,0 +1,37 @@
+(*************************************************************************)
+(* This file is part of Colibri2. *)
+(* *)
+(* Copyright (C) 2014-2021 *)
+(* CEA (Commissariat à l'énergie atomique et aux énergies *)
+(* alternatives) *)
+(* *)
+(* you can redistribute it and/or modify it under the terms of the GNU *)
+(* Lesser General Public License as published by the Free Software *)
+(* Foundation, version 2.1. *)
+(* *)
+(* It is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU Lesser General Public License for more details. *)
+(* *)
+(* See the GNU Lesser General Public License version 2.1 *)
+(* for more details (enclosed in the file licenses/LGPLv2.1). *)
+(*************************************************************************)
+
+val convert :
+ subst_old:Ground.Subst.t ->
+ subst_new:Ground.Subst.t ->
+ _ Egraph.t ->
+ Expr.Term.t ->
+ Node.t
+(** Same as {!Ground.convert} but try to reuse terms that are equal and already
+ in the egraph *)
+
+val convert_avoid_new_terms :
+ subst_old:Ground.Subst.t ->
+ subst_new:Ground.Subst.t ->
+ _ Egraph.t ->
+ Expr.Term.t ->
+ Node.t option
+(** Same as {!convert} but doesn't create new terms (except for skipped builtins
+ {!Trigger.Builtin_skipped_for_trigger.register} *)
diff --git a/src_colibri2/theories/quantifier/trigger.ml b/src_colibri2/theories/quantifier/trigger.ml
index d05efcaa16cf4e1023bbe419f5534d437376ce9e..7a8305445bba8051eee3057c70100053ec26b3e2 100644
--- a/src_colibri2/theories/quantifier/trigger.ml
+++ b/src_colibri2/theories/quantifier/trigger.ml
@@ -21,17 +21,43 @@
open Colibri2_popop_lib
open Common
-module T = struct
+type inst_step = NotSeen | Delayed | Instantiated
+
+module T : sig
+ type t = private {
+ id : int;
+ pat : Pattern.t;
+ pats : Pattern.t list;
+ checks : Pattern.t list;
+ form : Ground.ClosedQuantifier.t;
+ eager : bool;
+ substs : inst_step SubstTrie.t;
+ }
+
+ include Popop_stdlib.TaggedType with type t := t
+
+ val mk :
+ pat:Pattern.t ->
+ pats:Pattern.t list ->
+ checks:Pattern.t list ->
+ form:Ground.ClosedQuantifier.t ->
+ eager:bool ->
+ _ Egraph.t ->
+ t
+end = struct
open! Base
type t = {
+ id : int;
pat : Pattern.t;
pats : Pattern.t list;
checks : Pattern.t list;
form : Ground.ClosedQuantifier.t;
eager : bool;
+ substs : inst_step SubstTrie.t;
}
- [@@deriving eq, ord, hash]
+
+ let tag t = t.id
let pp fmt t =
Fmt.pf fmt "[%a, %a ( %a ) -> %a]" Pattern.pp t.pat
@@ -39,17 +65,39 @@ module T = struct
t.pats
Fmt.(list ~sep:comma Pattern.pp)
t.checks Ground.ClosedQuantifier.pp t.form
+
+ let id_get, id_incr = Util.get_counter ()
+
+ let mk ~pat ~pats ~checks ~form ~eager d =
+ id_incr ();
+ {
+ id = id_get ();
+ pat;
+ pats;
+ checks;
+ form;
+ eager;
+ substs = SubstTrie.create (Egraph.context d);
+ }
end
include T
-include Popop_stdlib.MkDatatype (T)
+include (Popop_stdlib.MakeMSH (T) : Popop_stdlib.Datatype with type t := t)
-let register_builtin_skipped_for_trigger, builtin_skipped_for_trigger =
- let q = Base.Queue.create () in
- ( Base.Queue.enqueue q,
- fun builtin -> Base.Queue.exists q ~f:(fun p -> p builtin) )
+let pattern_remove_coercion_option =
+ Options.register ~pp:Fmt.bool "Quant.pattern_coercion"
+ Cmdliner.Arg.(
+ value & flag
+ & info [ "remove-coercion-in-pattern" ] ~doc:"Remove coercion in patterns")
-let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
+let pattern_of_term d (cq : Ground.ClosedQuantifier.s) pat =
+ try
+ Pattern.of_term_exn
+ ~coercion:(not (Options.get d pattern_remove_coercion_option))
+ ~subst:cq.subst pat
+ with Pattern.Unconvertible -> raise Impossible
+
+let compute_top_triggers d (cq : Ground.ClosedQuantifier.t) =
let cq' = Ground.ClosedQuantifier.sem cq in
let tyvs = cq'.ty_vars in
let tvs = cq'.term_vars in
@@ -76,24 +124,12 @@ let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
aux pats (Expr.Term.subst Expr.Subst.empty subst f)
| Expr.Binder (_, _) -> pats (* todo *)
| Expr.Match (_, _) -> pats (* todo *)
- | Expr.App
- ( {
- term_descr =
- Cst
- {
- builtin =
- ( Expr.And | Expr.Equal | Expr.Equiv | Expr.Or | Expr.Xor
- | Expr.Imply | Expr.Ite | Expr.Neg );
- _;
- };
- _;
- },
- _,
- tl ) ->
- List.fold_left aux pats tl
| Expr.App ({ term_descr = Cst { builtin; _ }; _ }, _, tl)
- when builtin_skipped_for_trigger builtin ->
+ when Info.Builtin_skipped_for_trigger.skipped d builtin ->
List.fold_left aux pats tl
+ | Expr.Var _ ->
+ (* variable alone are bad pattern *)
+ pats
| _ -> t :: pats
in
let pats = CCList.sort_uniq ~cmp:Expr.Term.compare (aux [] t) in
@@ -105,7 +141,7 @@ let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
let sty, st =
Expr.Term.free_vars (Expr.Ty.Var.S.empty, Expr.Term.Var.S.empty) pat
in
- let pat = Pattern.of_term ~subst:cq'.subst pat in
+ let pat = pattern_of_term d cq' pat in
(pat, sty, st))
pats
in
@@ -157,13 +193,8 @@ let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
| [] -> acc
| a :: l ->
aux
- ({
- pat = a;
- pats = other @ l;
- checks = pats_partial;
- form = cq;
- eager = true;
- }
+ (mk d ~pat:a ~pats:(other @ l) ~checks:pats_partial ~form:cq
+ ~eager:true
:: acc)
(a :: other) l
in
@@ -184,13 +215,9 @@ let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
| [] -> acc
| a :: l ->
aux
- ({
- pat = a;
- pats = [];
- checks = other @ l @ pats_partial;
- form = cq;
- eager = true;
- }
+ (mk d ~pat:a ~pats:[]
+ ~checks:(other @ l @ pats_partial)
+ ~form:cq ~eager:true
:: acc)
(a :: other) l
in
@@ -207,7 +234,7 @@ let compute_top_triggers (cq : Ground.ClosedQuantifier.t) =
pats_full_with_others;
pats_full_with_others
-let compute_all_triggers (cq : Ground.ClosedQuantifier.t) =
+let compute_all_triggers d (cq : Ground.ClosedQuantifier.t) =
let cq' = Ground.ClosedQuantifier.sem cq in
let tyvs = cq'.ty_vars in
let tvs = cq'.term_vars in
@@ -252,19 +279,14 @@ let compute_all_triggers (cq : Ground.ClosedQuantifier.t) =
(fun (c, (sty, st)) ->
if Expr.Ty.Var.S.subset tyvs sty && Expr.Term.Var.S.subset tvs st then
Some
- {
- pat = Pattern.of_term ~subst:cq'.subst c;
- pats = [];
- form = cq;
- eager = true;
- checks = [];
- }
+ (mk d ~pat:(pattern_of_term d cq' c) ~pats:[] ~form:cq ~eager:true
+ ~checks:[])
else None)
pats
in
pats
-let get_user_triggers (cq : Ground.ClosedQuantifier.t) =
+let get_user_triggers d (cq : Ground.ClosedQuantifier.t) =
let cq' = Ground.ClosedQuantifier.sem cq in
let pats = Expr.Term.get_tag_list cq'.body Expr.Tags.triggers in
let tyvs = Expr.Ty.Var.S.of_list cq'.ty_vars in
@@ -278,18 +300,12 @@ let get_user_triggers (cq : Ground.ClosedQuantifier.t) =
pats
in
if Expr.Ty.Var.S.subset tyvs sty && Expr.Term.Var.S.subset tvs st then
- let pats = List.map (Pattern.of_term ~subst:cq'.subst) pats in
+ let pats = List.map (pattern_of_term d cq') pats in
let rec aux acc other = function
| [] -> acc
| a :: l ->
aux
- ({
- pat = a;
- pats = other @ l;
- checks = [];
- form = cq;
- eager = true;
- }
+ (mk d ~pat:a ~pats:(other @ l) ~checks:[] ~form:cq ~eager:true
:: acc)
(a :: other) l
in
@@ -298,26 +314,35 @@ let get_user_triggers (cq : Ground.ClosedQuantifier.t) =
in
pats
-let env_vars = Datastructure.Push.create pp "Quantifier.Trigger.vars"
+type tri_callback = Trigger of t | Callback of Callback.t [@@deriving show]
+
+let env_vars =
+ Datastructure.Push.create pp_tri_callback "Quantifier.Trigger.vars"
let env_tri_by_apps =
- F.EnvApps.create (Context.Push.pp ~sep:Fmt.semi pp)
+ F.EnvApps.create (Context.Push.pp ~sep:Fmt.semi pp_tri_callback)
"Quantifier.Trigger.tri_by_apps" (fun c _ -> Context.Push.create c)
-let add_trigger d t =
- match t.pat with
+let register_pattern d (pat : Pattern.t) t =
+ match pat with
| Var _ -> Datastructure.Push.push env_vars d t
| App (f, _, _) -> Context.Push.push (F.EnvApps.find env_tri_by_apps d f) t
| Node _ -> ()
+let add_trigger d t = register_pattern d t.pat (Trigger t)
+let add_callback d c = register_pattern d (Callback.pattern c) (Callback c)
+
let instantiate_aux d tri subst =
+ SubstTrie.set tri.substs subst Instantiated;
let form = Ground.ClosedQuantifier.sem tri.form in
Debug.incr nb_instantiation;
let subst = Ground.Subst.distinct_union subst form.subst in
let n = Ground.convert ~subst d form.body in
+ (* let n = Subst.convert ~subst_old:form.subst ~subst_new:subst d form.body in *)
if
Colibri2_stdlib.Debug.test_flag Colibri2_stdlib.Debug.stats
- && not (Egraph.is_registered d n)
+ && not (Egraph.is_equal d n (Ground.ClosedQuantifier.node tri.form))
+ (* not (Egraph.is_registered d n) *)
then Debug.incr nb_new_instantiation;
Egraph.register d n;
Egraph.merge d n (Ground.ClosedQuantifier.node tri.form)
@@ -339,9 +364,10 @@ module Delayed_instantiation = struct
let run d (tri, subst) =
let instantiate d =
- Debug.dprintf8 debug
- "[Quant] %a delayed instantiation %a, pat %a, checks:%a" Ground.Subst.pp
- subst Ground.ClosedQuantifier.pp tri.form
+ Debug.dprintf10 debug_instantiation
+ "[Quant] %a delayed instantiation %a, pat %a %a, checks:%a"
+ Ground.Subst.pp subst Ground.ClosedQuantifier.pp tri.form Pattern.pp
+ tri.pat
Fmt.(list ~sep:comma Pattern.pp)
tri.pats
Fmt.(list ~sep:comma Pattern.pp)
@@ -359,34 +385,88 @@ end
let () = Events.register (module Delayed_instantiation)
-let instantiate d tri subst =
- let subst =
- {
- subst with
- Ground.Subst.term =
- Expr.Term.Var.M.map (Egraph.find_def d) subst.Ground.Subst.term;
- }
+let mode_option =
+ Options.register ~pp:Fmt.bool "Quant.old"
+ Cmdliner.Arg.(
+ value & flag & info [ "quant-old" ] ~doc:"Use quant old heuristic")
+
+let no_eager_instantiation =
+ Options.register ~pp:Fmt.bool "Quant.no_eager_instantiation"
+ Cmdliner.Arg.(
+ value & flag
+ & info [ "no-eager-instantiation" ] ~doc:"Don't do eager instantiation")
+
+let instantiate' d tri subst =
+ let show_debug debug =
+ Debug.dprintf11 debug
+ "[Quant] %a instantiation found %a, pat %a,%a, checks:%a, eager:%b"
+ Ground.Subst.pp subst Ground.ClosedQuantifier.pp tri.form Pattern.pp
+ tri.pat
+ Fmt.(list ~sep:comma Pattern.pp)
+ tri.pats
+ Fmt.(list ~sep:comma Pattern.pp)
+ tri.checks tri.eager
in
- Debug.dprintf9 debug
- "[Quant] %a instantiation found %a, pat %a, checks:%a, eager:%b"
- Ground.Subst.pp subst Ground.ClosedQuantifier.pp tri.form
- Fmt.(list ~sep:comma Pattern.pp)
- tri.pats
- Fmt.(list ~sep:comma Pattern.pp)
- tri.checks tri.eager;
- if
- tri.eager
- && List.for_all
- (fun pat ->
- not (Node.S.is_empty (Pattern.check_term_exists d subst pat)))
- tri.checks
- then (
- Debug.incr nb_eager_instantiation;
- instantiate_aux d tri subst)
- else (
- Debug.dprintf0 debug "[Quant] Delayed";
- Debug.incr nb_delayed_instantiation;
- Events.new_pending_daemon d Delayed_instantiation.key (tri, subst))
+ let level_inst = SubstTrie.find_def ~default:NotSeen tri.substs subst in
+ let delayed () =
+ match level_inst with
+ | NotSeen ->
+ SubstTrie.set tri.substs subst Delayed;
+
+ Debug.dprintf0 debug_instantiation "[Quant] Delayed";
+ Debug.incr nb_delayed_instantiation;
+ Events.new_pending_daemon d Delayed_instantiation.key (tri, subst)
+ | Delayed | Instantiated ->
+ Debug.dprintf0 debug_instantiation "[Quant] Already delayed"
+ in
+ let no_eager_instantiation = Options.get d no_eager_instantiation in
+ match level_inst with
+ | Instantiated -> show_debug debug_full
+ | Delayed when no_eager_instantiation -> show_debug debug_full
+ | NotSeen when no_eager_instantiation -> delayed ()
+ | _ ->
+ show_debug debug_instantiation;
+ if Options.get d mode_option then
+ if
+ tri.eager
+ && List.for_all
+ (fun pat ->
+ not (Node.S.is_empty (Pattern.check_term_exists d subst pat)))
+ tri.checks
+ then (
+ Debug.incr nb_eager_instantiation;
+ instantiate_aux d tri subst;
+ Debug.dprintf0 debug "[Quant] Done")
+ else delayed ()
+ else if tri.eager then
+ let form = Ground.ClosedQuantifier.sem tri.form in
+ match
+ Subst.convert_avoid_new_terms ~subst_old:form.subst ~subst_new:subst d
+ form.body
+ with
+ | Some n ->
+ SubstTrie.set tri.substs subst Instantiated;
+ Debug.incr nb_instantiation;
+ Debug.incr nb_eager_instantiation;
+ if
+ Colibri2_stdlib.Debug.test_flag Colibri2_stdlib.Debug.stats
+ && not (Egraph.is_registered d n)
+ then Debug.incr nb_new_instantiation;
+ Egraph.register d n;
+ Egraph.merge d n (Ground.ClosedQuantifier.node tri.form);
+ Debug.dprintf0 debug "[Quant] Done"
+ | None -> delayed ()
+ else delayed ()
+
+let instantiate d t subst = instantiate' d t (Ground.Subst.map_repr d subst)
+
+let instantiate_many d t substs =
+ let substs =
+ Ground.Subst.S.fold_left
+ (fun acc s -> Ground.Subst.S.add (Ground.Subst.map_repr d s) acc)
+ Ground.Subst.S.empty substs
+ in
+ Ground.Subst.S.iter (instantiate' d t) substs
let match_ d tri n =
Debug.dprintf4 debug "[Quant] match %a %a" pp tri Node.pp n;
diff --git a/src_colibri2/theories/quantifier/trigger.mli b/src_colibri2/theories/quantifier/trigger.mli
index 3299fe2f1b42a1c64565f1515a8b2d600f903755..3e77f52321b71b5524881a6559a133ad6c721f8f 100644
--- a/src_colibri2/theories/quantifier/trigger.mli
+++ b/src_colibri2/theories/quantifier/trigger.mli
@@ -20,7 +20,10 @@
(** Trigger *)
-type t = {
+type inst_step = NotSeen | Delayed | Instantiated
+
+type t = private {
+ id : int;
pat : Pattern.t; (** The pattern on which to wait for a substitution *)
pats : Pattern.t list;
(** The other ones used to obtain a complete
@@ -29,29 +32,35 @@ type t = {
form : Ground.ClosedQuantifier.t; (** the body of the formula *)
eager : bool;
(** If it should be eagerly applied, otherwise wait for LastEffort *)
+ substs : inst_step SubstTrie.t;
}
include Colibri2_popop_lib.Popop_stdlib.Datatype with type t := t
-val compute_top_triggers : Ground.ClosedQuantifier.t -> t list
+val compute_top_triggers : _ Egraph.t -> Ground.ClosedQuantifier.t -> t list
(** Compute triggers, that should only add logical connective or equalities are
new terms *)
-val compute_all_triggers : Ground.ClosedQuantifier.t -> t list
+val compute_all_triggers : _ Egraph.t -> Ground.ClosedQuantifier.t -> t list
(** Compute all the triggers whose patterns contain all the variables of the formula *)
-val get_user_triggers : Ground.ClosedQuantifier.t -> t list
+val get_user_triggers : _ Egraph.t -> Ground.ClosedQuantifier.t -> t list
(** return the triggers given by the user *)
-val env_vars : t Datastructure.Push.t
+type tri_callback = Trigger of t | Callback of Callback.t [@@deriving show]
+
+val env_vars : tri_callback Datastructure.Push.t
(** Triggers that are only variables *)
-val env_tri_by_apps : t Context.Push.t F.EnvApps.t
+val env_tri_by_apps : tri_callback Context.Push.t F.EnvApps.t
(** Triggers sorted by their top symbol *)
val add_trigger : Egraph.wt -> t -> unit
(** Register a new trigger *)
+val add_callback : Egraph.wt -> Callback.t -> unit
+(** Register a new trigger *)
+
val instantiate : Egraph.wt -> t -> Ground.Subst.t -> unit
(** [instantiate d tri subst] instantiates the trigger [tri] with the
substitution [subst]:
@@ -62,10 +71,8 @@ val instantiate : Egraph.wt -> t -> Ground.Subst.t -> unit
* at last effort otherwise
*)
+val instantiate_many : Egraph.wt -> t -> Ground.Subst.S.t -> unit
+
val match_ : Egraph.wt -> t -> Node.t -> unit
(** [match_ d tri n] match the pattern of [tri] with [n] and instantiate [tri]
with the resulting substitutions *)
-
-val register_builtin_skipped_for_trigger : (Expr.builtin -> bool) -> unit
-(** The registered function tells when an application should be skipped when
- looking for patterns in a term (top down) *)
diff --git a/src_common/float_interval.mlw b/src_common/float_interval.mlw
index 939ba180713b94a29789b115370e5e37bde13a6f..962cdbcd623e2d02677113b3ab8d3a78a239f1af 100644
--- a/src_common/float_interval.mlw
+++ b/src_common/float_interval.mlw
@@ -20,6 +20,7 @@ module GenericFloat
use real.Truncate as Truncate
use real.RealInfix
use export RoundingMode
+ use bool.Bool
(** {2 Part I - Public Interface} *)
@@ -36,24 +37,35 @@ module GenericFloat
constant max_real : real (* defined when cloning *)
predicate in_range (x:real) = -. max_real <=. x <=. max_real
+
+ axiom max_real_not_zero: max_real <> 0.
type finite = abstract {
r : real
}
invariant { in_range r }
invariant { r <> 0. }
+ by { r = max_real }
meta coercion function r
+ function mk_finite real : finite
+
+ axiom mk_finite_def: forall rr [mk_finite rr].
+ in_range rr -> rr <> 0. -> (mk_finite rr).r = rr
+
+ axiom mk_finite_fed: forall f:finite [r f].
+ (mk_finite (r f)) = f
+
type t =
| Zero bool
| Infinity bool
| NaN
- | Finite finite
+ | Finite finite
(** {3 Constructors and Constants} *)
- val constant zeroF : t (** +0.0 *)
+ let constant zeroF : t = Zero false (** +0.0 *)
(* exp_bias = 2^(eb - 1) - 1 *)
(* max_finite_exp = 2^sb - 2 - exp_bias = exp_bias *)
(* max_significand = (2^eb + 2^eb - 1) * 2^(1-eb) *)
@@ -63,19 +75,29 @@ module GenericFloat
(** {3 Operators} *)
- val function add mode t t : t
val function sub mode t t : t
val function mul mode t t : t
val function div mode t t : t
(** The four basic operations, rounded in the given mode *)
val function abs t : t (** Absolute value *)
- val function neg t : t (** Opposite *)
+
+ (** Opposite *)
+ function neg (x:t) : t =
+ match x with
+ | NaN -> NaN
+ | Zero neg -> Zero (notb neg)
+ | Finite f -> Finite (mk_finite (-. (f.r)))
+ | Infinity neg -> Infinity (notb neg)
+ end
+
+ val neg (x:t) : t
+ ensures { result = neg x }
+
val function fma mode t t t : t (** Fused multiply-add: x * y + z *)
val function sqrt mode t : t (** Square root *)
let function (.-_) (x:t) : t = neg x
- let function (.+) (x y:t) : t = add RNE x y
let function (.-) (x y:t) : t = sub RNE x y
let function (.*) (x y:t) : t = mul RNE x y
let function (./) (x y:t) : t = div RNE x y
@@ -102,9 +124,10 @@ module GenericFloat
*)
(** {3 Comparisons} *)
+ predicate sign (r:real) = r <. 0.
function to_real (x:t) : real =
match x with
- | NaN -> max_real +. 1.
+ | NaN -> max_real +. 2.
| Infinity neg -> if neg then -. max_real -. 1. else max_real +. 1.
| Zero _ -> 0.
| Finite r -> r
@@ -148,7 +171,7 @@ module GenericFloat
| Zero _, Zero _ -> true
| Zero _, Finite r -> 0. <=. r
| Finite r, Zero _ -> r <=. 0.
- | Finite r1, Finite r2 -> r1 <=. r2
+ | Finite r1, Finite r2 -> r1.r <=. r2.r
| Infinity neg1, Infinity neg2 -> orb neg1 (notb neg2)
| _, Infinity neg2 -> notb neg2
| Infinity neg1, _ -> neg1
@@ -157,10 +180,36 @@ module GenericFloat
val le (f1:t) (f2:t) : bool
ensures { result = le f1 f2 }
- val predicate lt t t
+ predicate lt (f1:t) (f2:t) =
+ match f1, f2 with
+ | NaN, _ | _, NaN -> false
+ | Zero _, Zero _ -> false
+ | Zero _, Finite r -> 0. <. r
+ | Finite r, Zero _ -> r <. 0.
+ | Finite r1, Finite r2 -> r1.r <. r2.r
+ | Infinity neg1, Infinity neg2 -> andb neg1 (notb neg2)
+ | _, Infinity neg2 -> notb neg2
+ | Infinity neg1, _ -> neg1
+ end
+
+ val lt (f1:t) (f2:t) : bool
+ ensures { result = lt f1 f2 }
+
+ predicate eq (f1:t) (f2:t) =
+ match f1, f2 with
+ | Zero _, Zero _ -> true
+ | Finite r1, Finite r2 -> r1.r = r2.r
+ | Infinity neg1, Infinity neg2 -> neg1 = neg2
+ | _ -> false
+ end
+
+
+ val eq (f1:t) (f2:t) : bool
+ ensures { result = eq f1 f2 }
+
+
let predicate ge (x:t) (y:t) = le y x
let predicate gt (x:t) (y:t) = lt y x
- val predicate eq t t
(** equality on floats, different from = since not (eq NaN NaN) *)
let predicate (.<=) (x:t) (y:t) = le x y
@@ -196,8 +245,6 @@ module GenericFloat
axiom is_not_finite: forall x:t.
not (is_finite x) <-> (is_infinite x \/ is_nan x)
-
-
(** {3 Conversions from other sorts} *)
(* from bitvec binary interchange *)
@@ -280,7 +327,7 @@ module GenericFloat
axiom minus_max_real_round : forall m. round m (-. max_real) = -. max_real
- axiom is_finite: forall x:t. is_finite x -> in_range (to_real x)
+ goal is_finite: forall x:t. is_finite x <-> in_range (to_real x)
(* used as a condition to propagate is_finite *)
predicate no_overflow (m:mode) (x:real) = in_range (round m x)
@@ -332,62 +379,62 @@ module GenericFloat
predicate diff_sign (x y : t) =
(is_positive x /\ is_negative y) \/ (is_negative x /\ is_positive y)
- axiom feq_eq: forall x y.
+ goal feq_eq: forall x y.
is_finite x -> is_finite y -> not (is_zero x) -> x .= y -> x = y
- axiom eq_feq: forall x y.
+ goal eq_feq: forall x y.
is_finite x -> is_finite y -> x = y -> x .= y
- axiom eq_refl: forall x. is_finite x -> x .= x
+ goal eq_refl: forall x. is_finite x -> x .= x
- axiom eq_sym :
+ goal eq_sym :
forall x y. x .= y -> y .= x
- axiom eq_trans :
+ goal eq_trans :
forall x y z. x .= y -> y .= z -> x .= z
- axiom eq_zero: zeroF .= (.- zeroF)
+ goal eq_zero: zeroF .= (.- zeroF)
- axiom eq_to_real_finite: forall x y.
+ goal eq_to_real_finite: forall x y.
is_finite x /\ is_finite y -> (x .= y <-> to_real x = to_real y)
- axiom eq_special: forall x y. x .= y ->
+ goal eq_special: forall x y. x .= y ->
(is_not_nan x /\ is_not_nan y
/\ ((is_finite x /\ is_finite y)
\/ (is_infinite x /\ is_infinite y /\ same_sign x y)))
- axiom lt_finite: forall x y [lt x y].
+ goal lt_finite: forall x y [lt x y].
is_finite x /\ is_finite y -> (lt x y <-> to_real x <. to_real y)
- axiom le_finite: forall x y [le x y].
+ goal le_finite: forall x y [le x y].
is_finite x /\ is_finite y -> (le x y <-> to_real x <=. to_real y)
- lemma le_lt_trans:
+ goal le_lt_trans:
forall x y z:t. x .<= y /\ y .< z -> x .< z
- lemma lt_le_trans:
+ goal lt_le_trans:
forall x y z:t. x .< y /\ y .<= z -> x .< z
- lemma le_ge_asym:
+ goal le_ge_asym:
forall x y:t. x .<= y /\ x .>= y -> x .= y
- lemma not_lt_ge: forall x y:t.
+ goal not_lt_ge: forall x y:t.
not (x .< y) /\ is_not_nan x /\ is_not_nan y -> x .>= y
- lemma not_gt_le: forall x y:t.
+ goal not_gt_le: forall x y:t.
not (x .> y) /\ is_not_nan x /\ is_not_nan y -> x .<= y
- axiom le_special: forall x y [le x y]. le x y ->
+ goal le_special: forall x y [le x y]. le x y ->
((is_finite x /\ is_finite y)
\/ ((is_minus_infinity x /\ is_not_nan y)
\/ (is_not_nan x /\ is_plus_infinity y)))
- axiom lt_special: forall x y [lt x y]. lt x y ->
+ goal lt_special: forall x y [lt x y]. lt x y ->
((is_finite x /\ is_finite y)
\/ ((is_minus_infinity x /\ is_not_nan y /\ not (is_minus_infinity y))
\/ (is_not_nan x /\ not (is_plus_infinity x) /\ is_plus_infinity y)))
- axiom lt_lt_finite: forall x y z. lt x y -> lt y z -> is_finite y
+ goal lt_lt_finite: forall x y z. lt x y -> lt y z -> is_finite y
(* lemmas on sign *)
axiom positive_to_real: forall x[is_positive x|to_real x >=. 0.0].
@@ -405,15 +452,15 @@ module GenericFloat
axiom negative_or_positive: forall x.
is_not_nan x -> is_positive x \/ is_negative x
- lemma diff_sign_trans:
+ goal diff_sign_trans:
forall x y z:t. (diff_sign x y /\ diff_sign y z) -> same_sign x z
- lemma diff_sign_product:
+ goal diff_sign_product:
forall x y:t.
(is_finite x /\ is_finite y /\ to_real x *. to_real y <. 0.0) ->
diff_sign x y
- lemma same_sign_product:
+ goal same_sign_product:
forall x y:t.
(is_finite x /\ is_finite y /\ same_sign x y) ->
to_real x *. to_real y >=. 0.0
@@ -447,17 +494,54 @@ module GenericFloat
end
(** {3 binary operations} *)
+ let function is_RTN mode =
+ match mode with
+ | RTN -> true
+ | _ -> false
+ end
- axiom add_finite: forall m:mode, x y:t [add m x y].
+ function add (mode:mode) (x:t) (y:t) : t =
+ match x, y with
+ | NaN, _ -> NaN
+ | _, NaN -> NaN
+ | Zero z1, Zero z2 -> if z1 = z2 then Zero z1 else Zero (is_RTN mode)
+ | Zero _, _ -> y
+ | _, Zero _ -> x
+ | Infinity z1, Infinity z2 -> if z1 = z2 then x else NaN
+ | Infinity _, _ -> x
+ | _, Infinity _ -> y
+ | Finite x, Finite y ->
+ let r = (round mode (x +. y)) in
+ if r = 0. then Zero (is_RTN mode)
+ else if in_range r then
+ Finite (mk_finite r)
+ else
+ match mode with
+ | RTN -> if sign r then Infinity true
+ else Finite (mk_finite max_real)
+ | RTP -> if sign r then Finite (mk_finite (-. max_real))
+ else Infinity false
+ | RTZ -> if sign r then Finite (mk_finite (-. max_real))
+ else Finite (mk_finite max_real)
+ | (RNA | RNE) -> Infinity (sign r)
+ end
+ end
+
+ val add (mode:mode) (x y:t) : t
+ ensures { result = add mode x y }
+
+ let function (.+) (x y:t) : t = add RNE x y
+
+ goal add_finite: forall m:mode, x y:t [add m x y].
is_finite x -> is_finite y -> no_overflow m (to_real x +. to_real y) ->
is_finite (add m x y) /\
to_real (add m x y) = round m (to_real x +. to_real y)
- lemma add_finite_rev: forall m:mode, x y:t [add m x y].
+ goal add_finite_rev: forall m:mode, x y:t [add m x y].
is_finite (add m x y) ->
is_finite x /\ is_finite y
- lemma add_finite_rev_n: forall m:mode, x y:t [add m x y].
+ goal add_finite_rev_n: forall m:mode, x y:t [add m x y].
to_nearest m ->
is_finite (add m x y) ->
no_overflow m (to_real x +. to_real y) /\
@@ -468,11 +552,11 @@ module GenericFloat
is_finite (sub m x y) /\
to_real (sub m x y) = round m (to_real x -. to_real y)
- lemma sub_finite_rev: forall m:mode, x y:t [sub m x y].
+ goal sub_finite_rev: forall m:mode, x y:t [sub m x y].
is_finite (sub m x y) ->
is_finite x /\ is_finite y
- lemma sub_finite_rev_n: forall m:mode, x y:t [sub m x y].
+ goal sub_finite_rev_n: forall m:mode, x y:t [sub m x y].
to_nearest m ->
is_finite (sub m x y) ->
no_overflow m (to_real x -. to_real y) /\
@@ -483,11 +567,11 @@ module GenericFloat
is_finite (mul m x y) /\
to_real (mul m x y) = round m (to_real x *. to_real y)
- lemma mul_finite_rev: forall m:mode, x y:t [mul m x y].
+ goal mul_finite_rev: forall m:mode, x y:t [mul m x y].
is_finite (mul m x y) ->
is_finite x /\ is_finite y
- lemma mul_finite_rev_n: forall m:mode, x y:t [mul m x y].
+ goal mul_finite_rev_n: forall m:mode, x y:t [mul m x y].
to_nearest m ->
is_finite (mul m x y) ->
no_overflow m (to_real x *. to_real y) /\
@@ -499,12 +583,12 @@ module GenericFloat
is_finite (div m x y) /\
to_real (div m x y) = round m (to_real x /. to_real y)
- lemma div_finite_rev: forall m:mode, x y:t [div m x y].
+ goal div_finite_rev: forall m:mode, x y:t [div m x y].
is_finite (div m x y) ->
(is_finite x /\ is_finite y /\ not is_zero y) \/
(is_finite x /\ is_infinite y /\ to_real (div m x y) = 0.)
- lemma div_finite_rev_n: forall m:mode, x y:t [div m x y].
+ goal div_finite_rev_n: forall m:mode, x y:t [div m x y].
to_nearest m ->
is_finite (div m x y) -> is_finite y ->
no_overflow m (to_real x /. to_real y) /\
@@ -515,7 +599,7 @@ module GenericFloat
is_finite (neg x) /\
to_real (neg x) = -. to_real x
- lemma neg_finite_rev: forall x:t [neg x].
+ goal neg_finite_rev: forall x:t [neg x].
is_finite (neg x) ->
is_finite x /\
to_real (neg x) = -. to_real x
@@ -526,7 +610,7 @@ module GenericFloat
to_real (abs x) = Abs.abs (to_real x) /\
is_positive (abs x)
- lemma abs_finite_rev: forall x:t [abs x].
+ goal abs_finite_rev: forall x:t [abs x].
is_finite (abs x) ->
is_finite x /\
to_real (abs x) = Abs.abs (to_real x)
@@ -539,11 +623,11 @@ module GenericFloat
is_finite (fma m x y z) /\
to_real (fma m x y z) = round m (to_real x *. to_real y +. to_real z)
- lemma fma_finite_rev: forall m:mode, x y z:t [fma m x y z].
+ goal fma_finite_rev: forall m:mode, x y z:t [fma m x y z].
is_finite (fma m x y z) ->
is_finite x /\ is_finite y /\ is_finite z
- lemma fma_finite_rev_n: forall m:mode, x y z:t [fma m x y z].
+ goal fma_finite_rev_n: forall m:mode, x y z:t [fma m x y z].
to_nearest m ->
is_finite (fma m x y z) ->
no_overflow m (to_real x *. to_real y +. to_real z) /\
@@ -556,7 +640,7 @@ module GenericFloat
is_finite (sqrt m x) /\
to_real (sqrt m x) = round m (S.sqrt (to_real x))
- lemma sqrt_finite_rev: forall m:mode, x:t [sqrt m x].
+ goal sqrt_finite_rev: forall m:mode, x:t [sqrt m x].
is_finite (sqrt m x) ->
is_finite x /\ to_real x >=. 0. /\
to_real (sqrt m x) = round m (S.sqrt (to_real x))
@@ -566,7 +650,7 @@ module GenericFloat
axiom same_sign_real_round: forall x m r[same_sign_real x (round m r)]. same_sign_real x (round m r) -> same_sign_real x r
- axiom add_special: forall m:mode, x y:t [add m x y].
+ goal add_special: forall m:mode, x y:t [add m x y].
let r = add m x y in
(is_nan x \/ is_nan y -> is_nan r)
/\
@@ -698,10 +782,10 @@ module GenericFloat
(* min and max *)
- lemma Min_r : forall x y:t. y .<= x -> (min x y) .= y
- lemma Min_l : forall x y:t. x .<= y -> (min x y) .= x
- lemma Max_r : forall x y:t. y .<= x -> (max x y) .= x
- lemma Max_l : forall x y:t. x .<= y -> (max x y) .= y
+ goal Min_r : forall x y:t. y .<= x -> (min x y) .= y
+ goal Min_l : forall x y:t. x .<= y -> (min x y) .= x
+ goal Max_r : forall x y:t. y .<= x -> (max x y) .= x
+ goal Max_l : forall x y:t. x .<= y -> (max x y) .= y
(* _____________ *)
@@ -855,7 +939,7 @@ module Float_interval
predicate valid (x:t) =
match x with
| Inan -> true
- | Intv l h _ -> F.(l .<= h)
+ | Intv l h _ -> F.(l .<= h) /\ F.is_not_nan l /\ F.is_not_nan h
end
predicate mem (x:F.t) (i:t) =
@@ -895,64 +979,28 @@ module Float_interval
F.is_nan (F.add m f1 f2) -> F.is_infinite f1
goal G1: forall f. F.is_plus_infinity f -> f = F.Infinity false
-
- let ghost test3 m f1 f2 f3 =
- requires { not F.(is_nan (add m f1 f3)) }
- requires { not F.(is_nan (add m f2 f3)) }
+
+ lemma G2: forall m f1 f2 f3.
+ not F.(is_nan (add m f1 f3)) -> not F.(is_nan (add m f2 f3)) -> F.(le f1 f2) ->
+ F.(le (add m f1 f3) (add m f2 f3))
+
+ let ghost monotone_add (m:F.mode) (f1:F.t) (f2:F.t) (f3:F.t) =
+ requires { F.(is_not_nan (add m f1 f3)) }
+ requires { F.(is_not_nan (add m f2 f3)) }
requires { F.(le f1 f2) }
- ensures { F.(le (add m f1 f3) (add m f2 f3)) }
- if F.is_finite f1 then
- if F.is_finite f2 then
- if F.is_finite f3 then
- if F.no_overflow m F.((to_real f1) +. (to_real f3)) then
- 1
- else if F.no_overflow m F.((to_real f2) +. (to_real f3)) then begin
-
-(* assert { F.(to_real f1) <=. (F.to_real f2) };
- assert { (F.to_real f1) +. (F.to_real f3) <=. (F.to_real f2) +. (F.to_real f3) };
- assert { (F.to_real (F.add m f1 f3)) <=. (F.to_real (F.add m f2 f3)) };
- assert { (F.is_finite (F.add m f1 f3)) };
- assert { (F.is_finite (F.add m f2 f3)) };
- assert { F.(le (add m f1 f3) (add m f2 f3)) }; *)
- 6
- end
- else begin (*
- assert { F.overflow_value m (F.add m f2 f3) };
- assert { F.overflow_value m (F.add m f1 f3) }; *)
- if F.is_plus_infinity (F.add m f2 f3) then begin
- (* assert { not (F.is_nan F.(add m f1 f3)) }; *)
- (* assert { F.(same_sign_real (add m f2 f3) ((to_real f2) +. (to_real f3))) }; *)
- (* assert { F.(same_sign_real (add m f1 f3) ((to_real f1) +. (to_real f3))) }; *)
- 51
- end
- else if F.is_minus_infinity (F.add m f2 f3) then begin
- 52
- end
- else if F.(to_real (F.add m f2 f3) = max_real) then 53 else
- if F.(to_real (F.add m f2 f3) = -. max_real) then 54
- else 55
- end
- else begin
- 4
- end
- else 2
- else begin
- if F.is_plus_infinity f1 then begin
- assert { F.is_plus_infinity f2 };
- assert { f1 = F.Infinity false };
- assert { f2 = F.Infinity false };
- 66;
- end else begin
- assert { F.is_minus_infinity f1 };
- 67
- end
- end
-
- let cadd (m : F.mode) plus_infinity minus_infinity (i1 i2: t) : t
+ ensures { F.(le (add m f1 f3) (add m f2 f3)) } ()
+
+ let ghost monotone_add2 (m:F.mode) (f3:F.t) (f1:F.t) (f2:F.t) =
+ requires { F.(is_not_nan (add m f3 f1)) }
+ requires { F.(is_not_nan (add m f3 f2)) }
+ requires { F.(le f1 f2) }
+ ensures { F.(le (add m f3 f1) (add m f3 f2)) } ()
+
+
+
+ let cadd (m : F.mode) (i1 i2: t) : t
requires { valid i1 }
requires { valid i2 }
- requires { F.is_plus_infinity plus_infinity }
- requires { F.is_minus_infinity minus_infinity }
ensures { forall f1 f2. mem f1 i1 -> mem f2 i2 -> mem F.(add m f1 f2) result } =
match i1, i2 with
| Inan, _ | _, Inan -> Inan
@@ -979,14 +1027,97 @@ module Float_interval
assert { F.is_plus_infinity h1 \/ F.is_plus_infinity h2 };
assert { forall f1 f2. mem f1 i1 -> mem f2 i2 -> (F.is_plus_infinity f1 \/ F.is_plus_infinity f2 \/ F.is_nan f1 \/ F.is_nan f2) };
assert { forall f1 f2. mem f1 i1 -> mem f2 i2 -> (F.is_plus_infinity F.(f1.+f2) \/ F.is_nan F.(f1.+f2)) };
- Intv plus_infinity plus_infinity true
+ Intv (F.Infinity false) (F.Infinity false) true
end
else
if F.is_nan sum2 then
- Intv minus_infinity minus_infinity true
+ Intv (F.Infinity true) (F.Infinity true) true
else Intv sum1 sum2 (orb (orb (orb b1 b2)
F.(andb (F.is_plus_infinity h1) (F.is_minus_infinity l2)))
F.(andb (F.is_plus_infinity h2) (F.is_minus_infinity l1)))
end
+(* let ghost add_nan (m:mode) (f1:F.t) (f2:F.t) F.is_not_nan f1 -> F.is_not_nan f2 -> F.is_nan (F.add m f1 f2) -> F.diff_sign f1 f2 /\ F.is_infinite f1 /\ F.is_infinite f2 *)
+
+ let ghost add_nan (m:F.mode) (f1:F.t) (f2:F.t)
+ requires { F.is_not_nan f1 }
+ requires { F.is_not_nan f2 }
+ requires { F.is_nan (F.add m f1 f2) }
+ ensures { match f1, f2 with
+ | F.Infinity neg1, F.Infinity neg2 -> neg1 <> neg2
+ | _ -> false
+ end } = ()
+
+ let ghost add_not_nan (m:F.mode) (f1:F.t) (f2:F.t)
+ requires { F.is_not_nan (F.add m f1 f2) }
+ ensures { match f1, f2 with
+ | F.NaN, _ | _, F.NaN -> false
+ | F.Infinity neg1, F.Infinity neg2 -> neg1 = neg2
+ | _ -> true
+ end } = ()
+
+
+ goal add_not_nan: forall m f1 f2[F.is_nan (F.add m f1 f2)]. F.is_not_nan f1 -> F.is_not_nan f2 -> F.is_not_nan (F.add m f1 f2) ->
+ (F.same_sign f1 f2 /\ F.is_infinite f1 /\ F.is_infinite f2) \/ F.is_finite f1 \/ F.is_finite f2
+
+ let cadd2 (m : F.mode) (i1 i2: t) : t
+ requires { valid i1 }
+ requires { valid i2 }
+ ensures { forall f1 f2. mem f1 i1 -> mem f2 i2 -> mem F.(add m f1 f2) result }
+ ensures { valid result } =
+ match i1, i2 with
+ | Inan, _ | _, Inan -> Inan
+ | Intv l1 h1 b1, Intv l2 h2 b2 ->
+ let sum1 = F.add m l1 l2 in
+ let sum2 = F.add m h1 h2 in
+ if F.is_nan sum1 then
+ if F.is_nan sum2 then begin
+ Inan
+ end
+ else begin
+ Intv (F.Infinity false) (F.Infinity false) true
+ end
+ else
+ if F.is_nan sum2 then
+ Intv (F.Infinity true) (F.Infinity true) true
+ else Intv sum1 sum2 (orb (orb (orb b1 b2)
+ F.(andb (F.is_plus_infinity h1) (F.is_minus_infinity l2)))
+ F.(andb (F.is_plus_infinity h2) (F.is_minus_infinity l1)))
+ end
+
+ let cadd3 (m : F.mode) (i1 i2: t) : t
+ requires { valid i1 }
+ requires { valid i2 }
+ ensures { forall f1 f2. mem f1 i1 -> mem f2 i2 -> mem F.(add m f1 f2) result }
+ ensures { valid result } =
+ match i1, i2 with
+ | Inan, _ | _, Inan -> Inan
+ | Intv l1 h1 b1, Intv l2 h2 b2 ->
+ let sum1 = F.add m l1 l2 in
+ let sum2 = F.add m h1 h2 in
+ match F.is_nan sum1, F.is_nan sum2 with
+ | True, True -> add_nan m l1 l2; add_nan m h1 h2; Inan
+ | True, False -> add_nan m l1 l2; Intv (F.Infinity false) (F.Infinity false) true
+ | False, True -> add_nan m h1 h2; Intv (F.Infinity true) (F.Infinity true) true
+ | False, False ->begin
+ add_not_nan m l1 l2;
+ add_not_nan m h1 h2;
+ let lemma sum1_le (f1:F.t) (f2:F.t) =
+ requires { mem f1 i1 }
+ requires { mem f2 i2 }
+ requires { F.is_not_nan (F.add m l1 l2) }
+ requires { F.is_not_nan (F.add m f1 f2) }
+ ensures { F.le (F.add m l1 l2) (F.add m f1 f2) }
+ add_not_nan m f1 f2;
+ monotone_add m l1 f1 f2;
+ monotone_add2 m l1 l2 f2;
+ in
+ Intv sum1 sum2 (orb (orb (orb b1 b2)
+ F.(andb (F.is_plus_infinity h1) (F.is_minus_infinity l2)))
+ F.(andb (F.is_plus_infinity h2) (F.is_minus_infinity l1)))
+ end
+ end
+ end
+
+
end
diff --git a/src_common/float_interval/why3session.xml b/src_common/float_interval/why3session.xml
index 23f3b80bbcbcd13fbf8d7e98185d7554a9d734be..94c561372187f2d385b52fa1b1d8ff75d8eaa9e1 100644
--- a/src_common/float_interval/why3session.xml
+++ b/src_common/float_interval/why3session.xml
@@ -6,67 +6,160 @@
<file format="whyml">
<path name=".."/><path name="float_interval.mlw"/>
<theory name="GenericFloat">
- <goal name="finite'vc" expl="VC for finite">
+ <goal name="finite'vc" expl="VC for finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.06"/></proof>
</goal>
- <goal name="le_lt_trans">
+ <goal name="is_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
</goal>
- <goal name="lt_le_trans">
+ <goal name="feq_eq" proved="true">
+ <proof prover="0"><result status="valid" time="0.07"/></proof>
</goal>
- <goal name="le_ge_asym">
+ <goal name="eq_feq" proved="true">
+ <proof prover="0"><result status="valid" time="0.07"/></proof>
</goal>
- <goal name="not_lt_ge">
+ <goal name="eq_refl" proved="true">
+ <proof prover="0"><result status="valid" time="0.07"/></proof>
</goal>
- <goal name="not_gt_le">
+ <goal name="eq_sym" proved="true">
+ <proof prover="0"><result status="valid" time="0.07"/></proof>
</goal>
- <goal name="diff_sign_trans">
+ <goal name="eq_trans" proved="true">
+ <proof prover="0"><result status="valid" time="0.08"/></proof>
</goal>
- <goal name="diff_sign_product">
+ <goal name="eq_zero" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
- <goal name="same_sign_product">
+ <goal name="eq_to_real_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.16"/></proof>
</goal>
- <goal name="add_finite_rev">
+ <goal name="eq_special" proved="true">
+ <proof prover="0"><result status="valid" time="0.18"/></proof>
</goal>
- <goal name="add_finite_rev_n">
+ <goal name="lt_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.18"/></proof>
+ </goal>
+ <goal name="le_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
+ </goal>
+ <goal name="le_lt_trans" proved="true">
+ <proof prover="0"><path name="float_interval-GenericFloat-le_lt_trans_2.psmt2"/><undone/></proof>
+ <transf name="introduce_premises" proved="true" >
+ <goal name="le_lt_trans.0" proved="true">
+ <proof prover="0" obsolete="true"><path name="float_interval-GenericFloat-le_lt_trans_1.psmt2"/><result status="unknown" time="0.00" steps="0"/></proof>
+ <transf name="destruct_term" proved="true" arg1="x">
+ <goal name="le_lt_trans.0.0" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="le_lt_trans.0.1" proved="true">
+ <proof prover="0"><result status="valid" time="0.07"/></proof>
+ </goal>
+ <goal name="le_lt_trans.0.2" proved="true">
+ <proof prover="0"><result status="valid" time="0.12"/></proof>
+ </goal>
+ <goal name="le_lt_trans.0.3" proved="true">
+ <proof prover="0"><result status="valid" time="0.13"/></proof>
+ </goal>
+ </transf>
+ </goal>
+ </transf>
+ </goal>
+ <goal name="lt_le_trans" proved="true">
+ <proof prover="0"><result status="valid" time="0.15"/></proof>
+ </goal>
+ <goal name="le_ge_asym" proved="true">
+ <proof prover="0"><result status="valid" time="0.13"/></proof>
+ </goal>
+ <goal name="not_lt_ge" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
+ </goal>
+ <goal name="not_gt_le" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="le_special" proved="true">
+ <proof prover="0"><result status="valid" time="0.18"/></proof>
+ </goal>
+ <goal name="lt_special" proved="true">
+ <proof prover="0"><result status="valid" time="0.19"/></proof>
+ </goal>
+ <goal name="lt_lt_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.09"/></proof>
+ </goal>
+ <goal name="diff_sign_trans" proved="true">
+ <proof prover="0"><result status="valid" time="0.12"/></proof>
+ </goal>
+ <goal name="diff_sign_product" proved="true">
+ <proof prover="0"><result status="valid" time="0.16"/></proof>
+ </goal>
+ <goal name="same_sign_product" proved="true">
+ <proof prover="0"><result status="valid" time="0.16"/></proof>
+ </goal>
+ <goal name="add_finite" proved="true">
+ <proof prover="0"><result status="valid" time="0.13"/></proof>
+ </goal>
+ <goal name="add_finite_rev" proved="true">
+ <proof prover="0"><result status="valid" time="0.20"/></proof>
+ </goal>
+ <goal name="add_finite_rev_n" proved="true">
+ <proof prover="0"><result status="valid" time="0.40"/></proof>
</goal>
<goal name="sub_finite_rev">
+ <proof prover="0"><result status="unknown" time="0.19"/></proof>
</goal>
<goal name="sub_finite_rev_n">
+ <proof prover="0"><result status="unknown" time="0.19"/></proof>
</goal>
<goal name="mul_finite_rev">
+ <proof prover="0"><result status="unknown" time="0.20"/></proof>
</goal>
<goal name="mul_finite_rev_n">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
</goal>
<goal name="div_finite_rev">
+ <proof prover="0"><result status="unknown" time="0.12"/></proof>
</goal>
<goal name="div_finite_rev_n">
+ <proof prover="0"><result status="unknown" time="0.12"/></proof>
</goal>
- <goal name="neg_finite_rev">
+ <goal name="neg_finite_rev" proved="true">
+ <proof prover="0"><result status="valid" time="0.09"/></proof>
</goal>
<goal name="abs_finite_rev">
+ <proof prover="0"><result status="unknown" time="0.12"/></proof>
</goal>
- <goal name="fma_finite_rev">
+ <goal name="fma_finite_rev" proved="true">
+ <proof prover="0" timelimit="20"><result status="valid" time="0.16"/></proof>
</goal>
<goal name="fma_finite_rev_n">
+ <proof prover="0"><result status="unknown" time="0.11"/></proof>
</goal>
<goal name="sqrt_finite_rev">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
+ </goal>
+ <goal name="add_special">
+ <proof prover="0"><result status="unknown" time="0.72"/></proof>
</goal>
<goal name="Min_r">
+ <proof prover="0"><result status="unknown" time="0.13"/></proof>
</goal>
<goal name="Min_l">
+ <proof prover="0"><result status="unknown" time="0.12"/></proof>
</goal>
<goal name="Max_r">
+ <proof prover="0"><result status="unknown" time="0.13"/></proof>
</goal>
<goal name="Max_l">
+ <proof prover="0"><result status="unknown" time="0.14"/></proof>
</goal>
</theory>
<theory name="Float_interval">
<goal name="Test2" proved="true">
- <proof prover="0"><result status="valid" time="0.14"/></proof>
- <transf name="split_vc" >
- <goal name="Test2.0">
- <transf name="instantiate" arg1="is_not_finite" arg2="f1">
- <goal name="Test2.0.0">
- <proof prover="0" obsolete="true"><result status="valid" time="0.05"/></proof>
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
+ <transf name="split_vc" proved="true" >
+ <goal name="Test2.0" proved="true">
+ <transf name="instantiate" proved="true" arg1="is_not_finite" arg2="f1">
+ <goal name="Test2.0.0" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
</transf>
</goal>
@@ -85,7 +178,7 @@
</transf>
</goal>
<goal name="G1" proved="true">
- <proof prover="0"><path name="float_interval-Float_interval-G1_1.psmt2"/><result status="timeout" time="5.00"/></proof>
+ <proof prover="0"><result status="valid" time="0.09"/></proof>
<transf name="split_vc" proved="true" >
<goal name="G1.0" proved="true">
<transf name="unfold" proved="true" arg1="is_plus_infinity" arg2="in" arg3="H">
@@ -109,519 +202,264 @@
</goal>
</transf>
</goal>
- <goal name="test3'vc" expl="VC for test3">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
+ <goal name="G2" proved="true">
+ <proof prover="0"><result status="valid" time="1.76"/></proof>
+ </goal>
+ <goal name="monotone_add'vc" expl="VC for monotone_add" proved="true">
+ <proof prover="0"><result status="valid" time="0.31"/></proof>
+ </goal>
+ <goal name="monotone_add2'vc" expl="VC for monotone_add2" proved="true">
+ <proof prover="0" timelimit="100"><result status="valid" time="5.68"/></proof>
+ </goal>
+ <goal name="cadd'vc" expl="VC for cadd">
<transf name="split_vc" >
- <goal name="test3'vc.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.21"/></proof>
+ <goal name="cadd'vc.0" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.88"/></proof>
</goal>
- <goal name="test3'vc.1" expl="assertion">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="split_vc" >
- <goal name="test3'vc.1.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
+ <goal name="cadd'vc.1" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="4.28"/></proof>
</goal>
- <goal name="test3'vc.2" expl="assertion">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="split_vc" >
- <goal name="test3'vc.2.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
+ <goal name="cadd'vc.2" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="2.38"/></proof>
+ </goal>
+ <goal name="cadd'vc.3" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
+ </goal>
+ <goal name="cadd'vc.4" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.84"/></proof>
+ </goal>
+ <goal name="cadd'vc.5" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.24"/></proof>
+ </goal>
+ <goal name="cadd'vc.6" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.58"/></proof>
+ </goal>
+ <goal name="cadd'vc.7" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.29"/></proof>
+ </goal>
+ <goal name="cadd'vc.8" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.87"/></proof>
+ </goal>
+ <goal name="cadd'vc.9" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.80"/></proof>
+ </goal>
+ <goal name="cadd'vc.10" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.23"/></proof>
+ </goal>
+ <goal name="cadd'vc.11" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
</goal>
- <goal name="test3'vc.3" expl="assertion">
+ <goal name="cadd'vc.12" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.53"/></proof>
+ </goal>
+ <goal name="cadd'vc.13" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="0.88"/></proof>
+ </goal>
+ <goal name="cadd'vc.14" expl="assertion" proved="true">
+ <proof prover="0"><result status="valid" time="2.14"/></proof>
+ </goal>
+ <goal name="cadd'vc.15" expl="postcondition">
<transf name="split_vc" >
- <goal name="test3'vc.3.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.24"/></proof>
+ <goal name="cadd'vc.15.0" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="test3'vc.3.1" expl="postcondition">
- <proof prover="0"><path name="float_interval-Float_interval-test3qtvc_1.psmt2"/><undone/></proof>
+ <goal name="cadd'vc.15.1" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.12"/></proof>
</goal>
- <goal name="test3'vc.3.2" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.3.3" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.3.4" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd'vc.15.2" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.13"/></proof>
</goal>
- <goal name="test3'vc.3.5" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd'vc.15.3" expl="postcondition">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
</goal>
- <goal name="test3'vc.3.6" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ </transf>
+ </goal>
+ </transf>
+ </goal>
+ <goal name="add_nan'vc" expl="VC for add_nan" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="add_not_nan'vc" expl="VC for add_not_nan" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
+ </goal>
+ <goal name="add_not_nan" proved="true">
+ <proof prover="0"><result status="valid" time="0.09"/></proof>
+ </goal>
+ <goal name="cadd2'vc" expl="VC for cadd2">
+ <proof prover="0" timelimit="100" obsolete="true"><result status="timeout" time="177.00"/></proof>
+ <transf name="remove" arg1="zero,one,(-),(>),(<=),(>=),zero1,one1,(>'),(<='),(>='),(-'),(/),( *.),(<=.),andb,orb,notb,xorb,implb,Assoc1,Unit_def_l,Unit_def_r,Inv_def_l,Inv_def_r,Comm1,Assoc,Mul_distr_l,Mul_distr_r,Comm,Unitary,NonTrivialRing,Refl,Trans,Antisymm,Total,ZeroLessOne,CompatOrderAdd,CompatOrderMult,Assoc3,Unit_def_l1,Unit_def_r1,Inv_def_l1,Inv_def_r1,Comm3,Assoc2,Mul_distr_l1,Mul_distr_r1,Comm2,Unitary1,NonTrivialRing1,Inverse,add_div,sub_div,neg_div,assoc_mul_div,assoc_div_mul,assoc_div_div,Refl1,Trans1,Antisymm1,Total1,ZeroLessOne1,CompatOrderAdd1,CompatOrderMult1,Power_0,Power_s,Power_1,Power_sum,pow2_0,pow2_2,pow2_4,pow2_5,pow2_6">
+ <goal name="cadd2'vc.0" expl="VC for cadd2">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
+ </goal>
+ </transf>
+ <transf name="split_vc" >
+ <goal name="cadd2'vc.0" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
+ <transf name="split_vc" >
+ <goal name="cadd2'vc.0.0" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="test3'vc.3.7" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.0.1" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
</goal>
- <goal name="test3'vc.3.8" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.0.2" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.13"/></proof>
</goal>
- <goal name="test3'vc.3.9" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.3.10" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.0.3" expl="postcondition">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
</goal>
</transf>
</goal>
- <goal name="test3'vc.4" expl="postcondition">
+ <goal name="cadd2'vc.1" expl="postcondition">
<proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="test3'vc.5" expl="postcondition">
<transf name="split_vc" >
- <goal name="test3'vc.5.0" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.5.1" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.1.0" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
</goal>
- <goal name="test3'vc.5.2" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.1.1" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
</goal>
- <goal name="test3'vc.5.3" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.1.2" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
- <goal name="test3'vc.5.4" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.5.5" expl="postcondition">
- <proof prover="0"><undone/></proof>
- </goal>
- <goal name="test3'vc.5.6" expl="postcondition">
- <proof prover="0"><undone/></proof>
+ <goal name="cadd2'vc.1.3" expl="postcondition">
+ <proof prover="0"><result status="timeout" time="5.00"/></proof>
</goal>
</transf>
</goal>
</transf>
</goal>
- <goal name="cadd'vc" expl="VC for cadd">
- <transf name="split_vc" >
- <goal name="cadd'vc.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.47"/></proof>
+ <goal name="cadd3'vc" expl="VC for cadd3" proved="true">
+ <proof prover="0" timelimit="100" obsolete="true"><result status="timeout" time="100.00"/></proof>
+ <transf name="split_vc" proved="true" >
+ <goal name="cadd3'vc.0" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.1" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.91"/></proof>
+ <goal name="cadd3'vc.1" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.2" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.78"/></proof>
+ <goal name="cadd3'vc.2" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.06"/></proof>
</goal>
- <goal name="cadd'vc.3" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.30"/></proof>
+ <goal name="cadd3'vc.3" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
- <goal name="cadd'vc.4" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.4.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.35"/></proof>
- </goal>
- </transf>
+ <goal name="cadd3'vc.4" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.5" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.27"/></proof>
+ <goal name="cadd3'vc.5" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.06"/></proof>
</goal>
- <goal name="cadd'vc.6" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.29"/></proof>
+ <goal name="cadd3'vc.6" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
</goal>
- <goal name="cadd'vc.7" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.7.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.26"/></proof>
+ <goal name="cadd3'vc.7" expl="precondition" proved="true">
+ <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
+ <transf name="split_vc" proved="true" >
+ <goal name="cadd3'vc.7.0" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- </transf>
- </goal>
- <goal name="cadd'vc.8" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.8.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.50"/></proof>
+ <goal name="cadd3'vc.7.1" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="cadd3'vc.7.2" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="valid" time="0.13"/></proof>
+ </goal>
+ <goal name="cadd3'vc.7.3" expl="postcondition">
+ <proof prover="0" timelimit="20" obsolete="true"><result status="timeout" time="20.00"/></proof>
+ <transf name="split_vc" >
+ <goal name="cadd3'vc.7.3.0" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="timeout" time="10.00"/></proof>
+ </goal>
+ <goal name="cadd3'vc.7.3.1" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="timeout" time="10.00"/></proof>
+ </goal>
+ <goal name="cadd3'vc.7.3.2" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="timeout" time="10.00"/></proof>
+ </goal>
+ <goal name="cadd3'vc.7.3.3" expl="postcondition">
+ <proof prover="0" obsolete="true"><result status="timeout" time="10.00"/></proof>
+ </goal>
+ </transf>
</goal>
</transf>
</goal>
- <goal name="cadd'vc.9" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.37"/></proof>
+ <goal name="cadd3'vc.8" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
</goal>
- <goal name="cadd'vc.10" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.27"/></proof>
+ <goal name="cadd3'vc.9" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.11" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.11.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.28"/></proof>
- </goal>
- </transf>
+ <goal name="cadd3'vc.10" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.12" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.12.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.27"/></proof>
- </goal>
- </transf>
+ <goal name="cadd3'vc.11" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
- <goal name="cadd'vc.13" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.13.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="0.80"/></proof>
- </goal>
- </transf>
+ <goal name="cadd3'vc.12" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.04"/></proof>
</goal>
- <goal name="cadd'vc.14" expl="assertion">
- <transf name="split_vc" >
- <goal name="cadd'vc.14.0" expl="assertion">
- <proof prover="0" obsolete="true"><result status="valid" time="2.31"/></proof>
- </goal>
- </transf>
+ <goal name="cadd3'vc.13" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
- <goal name="cadd'vc.15" expl="postcondition">
- <transf name="split_vc" >
- <goal name="cadd'vc.15.0" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="0.10"/></proof>
+ <goal name="cadd3'vc.14" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.06"/></proof>
+ </goal>
+ <goal name="cadd3'vc.15" expl="precondition" proved="true">
+ <proof prover="0" timelimit="100"><result status="valid" time="46.74"/></proof>
+ </goal>
+ <goal name="cadd3'vc.16" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
+ </goal>
+ <goal name="cadd3'vc.17" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.06"/></proof>
+ </goal>
+ <goal name="cadd3'vc.18" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.03"/></proof>
+ </goal>
+ <goal name="cadd3'vc.19" expl="precondition" proved="true">
+ <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
+ <transf name="split_vc" proved="true" >
+ <goal name="cadd3'vc.19.0" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.43"/></proof>
</goal>
- <goal name="cadd'vc.15.1" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="0.11"/></proof>
+ <goal name="cadd3'vc.19.1" expl="postcondition">
+ <proof prover="0"><undone/></proof>
</goal>
- <goal name="cadd'vc.15.2" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="0.10"/></proof>
+ <goal name="cadd3'vc.19.2" expl="postcondition">
+ <proof prover="0"><undone/></proof>
</goal>
- <goal name="cadd'vc.15.3" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="1.22"/></proof>
+ <goal name="cadd3'vc.19.3" expl="postcondition">
+ <proof prover="0"><undone/></proof>
</goal>
- <goal name="cadd'vc.15.4" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_plus_infinity (f1 .+ f2))">
- <goal name="cadd'vc.15.4.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="valid" time="2.21"/></proof>
- </goal>
- <goal name="cadd'vc.15.4.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="valid" time="1.71"/></proof>
- </goal>
- </transf>
- <transf name="eliminate_let" >
- <goal name="cadd'vc.15.4.0" expl="postcondition">
- <transf name="instantiate" arg1="H3" arg2="f1,f2">
- <goal name="cadd'vc.15.4.0.0" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="2.42"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
+ </transf>
+ </goal>
+ <goal name="cadd3'vc.20" expl="precondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="cadd3'vc.21" expl="postcondition" proved="true">
+ <proof prover="0" timelimit="100"><result status="valid" time="5.80"/></proof>
+ </goal>
+ <goal name="cadd3'vc.22" expl="postcondition" proved="true">
+ <proof prover="0" timelimit="100"><result status="valid" time="89.44"/></proof>
+ <transf name="split_vc" proved="true" >
+ <goal name="cadd3'vc.22.0" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.05"/></proof>
</goal>
- <goal name="cadd'vc.15.5" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="valid" time="3.04"/></proof>
+ <goal name="cadd3'vc.22.1" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.10"/></proof>
</goal>
- <goal name="cadd'vc.15.6" expl="postcondition">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_plus_infinity x1)">
- <goal name="cadd'vc.15.6.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_plus_infinity x4)">
- <goal name="cadd'vc.15.6.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="case" arg1="(is_minus_infinity x2)">
- <goal name="cadd'vc.15.6.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="case" arg1="(is_minus_infinity x5)">
- <goal name="cadd'vc.15.6.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_plus_infinity x4)">
- <goal name="cadd'vc.15.6.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.1.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="case" arg1="(is_minus_infinity x2)">
- <goal name="cadd'vc.15.6.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.1.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="case" arg1="(is_minus_infinity x5)">
- <goal name="cadd'vc.15.6.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.1.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- <transf name="case" arg1="(is_finite1 f1)">
- <goal name="cadd'vc.15.6.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_finite1 f2)">
- <goal name="cadd'vc.15.6.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="eliminate_let_fmla" >
- <goal name="cadd'vc.15.6.0.0.0" expl="true case (postcondition)">
- <transf name="case" arg1="(no_overflow m ((to_real f1) +. (to_real f2)))">
- <goal name="cadd'vc.15.6.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(no_overflow m (to_real x5 +. to_real x2))">
- <goal name="cadd'vc.15.6.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_finite1 x5)">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0" expl="true case (postcondition)">
- <transf name="case" arg1="(is_finite1 x2)">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x5) <=. (to_real f2))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="(((to_real x5) +. (to_real x2)) <=. ((to_real f2) +. (to_real f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="(round m ((to_real x5) +. (to_real x2)) <=. round m ((to_real f2) +. (to_real f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real (add m x5 x2)) <=. (to_real (add m f2 f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="1.14"/></proof>
- <transf name="instantiate" arg1="add_finite" arg2="m, x5, x2">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.1.0" expl="asserted formula">
- <transf name="instantiate" arg1="add_finite" arg2="m, f2, f1">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.1.0.0" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="1.14"/></proof>
- <transf name="case" arg1="(no_overflow m (to_real x5 +. to_real x2))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.1.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="valid" time="1.07"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.0.1.0.0.1" expl="asserted formula (false case)">
- <proof prover="0" obsolete="true"><result status="valid" time="0.03"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.11"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.24"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.77"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.76"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="cut" arg1="(le (add m x2 x5) (f1 .+ f2))">
- <goal name="cadd'vc.15.6.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_finite1 x5)">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0" expl="true case (postcondition)">
- <transf name="case" arg1="(is_finite1 x2)">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.28"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.0.1.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_finite1 x5)">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0" expl="asserted formula (true case)">
- <transf name="case" arg1="(is_finite1 x2)">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x5) <=. (to_real f2))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="(((to_real x5) +. (to_real x2)) <=. ((to_real f2) +. (to_real f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="(round m ((to_real x5) +. (to_real x2)) <=. round m ((to_real f2) +. (to_real f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real (add m x5 x2)) <=. (to_real (add m f2 f1)))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="instantiate" arg1="add_finite" arg2="m, x5, x2">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.1.0" expl="asserted formula">
- <transf name="instantiate" arg1="add_finite" arg2="m, f2, f1">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.1.0.0" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(no_overflow m (to_real x5 +. to_real x2))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.1.0.0.0" expl="asserted formula (true case)">
- <proof prover="0" obsolete="true"><result status="valid" time="1.07"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.0.1.0.0.1" expl="asserted formula (false case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.10"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.23"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.63"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="valid" time="0.60"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.1" expl="asserted formula (false case. true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="cut" arg1="((to_real x2) <=. (to_real f1))">
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.1.0" expl="asserted formula (false case. true case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.0.1.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.0.1.1" expl="asserted formula (false case)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- <transf name="cut" arg1="(le (add m x2 x5) (f1 .+ f2))">
- <goal name="cadd'vc.15.6.0.0.0.0" expl="true case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.0.0.0.1" expl="asserted formula">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.0.1" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- <goal name="cadd'vc.15.6.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- <transf name="case" arg1="(is_finite1 f2)">
- <goal name="cadd'vc.15.6.1.0" expl="false case (true case. postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- <goal name="cadd'vc.15.6.1.1" expl="false case (postcondition)">
- <proof prover="0" obsolete="true"><result status="timeout" time="5.00"/></proof>
- </goal>
- </transf>
- </goal>
- </transf>
+ <goal name="cadd3'vc.22.2" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="0.11"/></proof>
+ </goal>
+ <goal name="cadd3'vc.22.3" expl="postcondition" proved="true">
+ <proof prover="0" timelimit="100"><result status="valid" time="58.99"/></proof>
</goal>
</transf>
</goal>
+ <goal name="cadd3'vc.23" expl="postcondition" proved="true">
+ <proof prover="0"><result status="valid" time="1.22"/></proof>
+ </goal>
</transf>
</goal>
</theory>