aboutsummaryrefslogtreecommitdiff
path: root/plugins/micromega
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/micromega')
-rw-r--r--plugins/micromega/MExtraction.v10
-rw-r--r--plugins/micromega/coq_micromega.ml378
-rw-r--r--plugins/micromega/g_micromega.ml41
-rw-r--r--plugins/micromega/micromega.ml326
-rw-r--r--plugins/micromega/micromega.mli139
-rw-r--r--plugins/micromega/sos_types.mli40
-rw-r--r--plugins/micromega/vo.itarget15
7 files changed, 444 insertions, 465 deletions
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index d28bb82863..2451aeada7 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -38,17 +38,17 @@ Extract Inductive sumor => option [ Some None ].
Let's rather use the ocaml && *)
Extract Inlined Constant andb => "(&&)".
-Require Import Reals.
+Import Reals.Rdefinitions.
-Extract Constant R => "int".
-Extract Constant R0 => "0".
-Extract Constant R1 => "1".
+Extract Constant R => "int".
+Extract Constant R0 => "0".
+Extract Constant R1 => "1".
Extract Constant Rplus => "( + )".
Extract Constant Rmult => "( * )".
Extract Constant Ropp => "fun x -> - x".
Extract Constant Rinv => "fun x -> 1 / x".
-Extraction "micromega.ml"
+Extraction "plugins/micromega/generated_micromega.ml"
List.map simpl_cone (*map_cone indexes*)
denorm Qpower vm_add
n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 053bb6fa13..fba1966df3 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -16,11 +16,11 @@
(* *)
(************************************************************************)
+open API
open Pp
open Mutils
open Goptions
-
-module Term = EConstr
+open Names
(**
* Debug flag
@@ -109,8 +109,8 @@ type 'cst atom = 'cst Micromega.formula
type 'cst formula =
| TT
| FF
- | X of Term.constr
- | A of 'cst atom * tag * Term.constr
+ | X of EConstr.constr
+ | A of 'cst atom * tag * EConstr.constr
| C of 'cst formula * 'cst formula
| D of 'cst formula * 'cst formula
| N of 'cst formula
@@ -328,10 +328,6 @@ let selecti s m =
module M =
struct
- open Coqlib
- open Constr
- open EConstr
-
(**
* Location of the Coq libraries.
*)
@@ -356,8 +352,8 @@ struct
["LRing_normalise"]]
let coq_modules =
- init_modules @
- [logic_dir] @ arith_modules @ zarith_base_modules @ mic_modules
+ Coqlib.(init_modules @
+ [logic_dir] @ arith_modules @ zarith_base_modules @ mic_modules)
let bin_module = [["Coq";"Numbers";"BinNums"]]
@@ -375,8 +371,8 @@ struct
* ZMicromega.v
*)
- let gen_constant_in_modules s m n = EConstr.of_constr (gen_constant_in_modules s m n)
- let init_constant = gen_constant_in_modules "ZMicromega" init_modules
+ let gen_constant_in_modules s m n = EConstr.of_constr (Universes.constr_of_global @@ Coqlib.gen_reference_in_modules s m n)
+ let init_constant = gen_constant_in_modules "ZMicromega" Coqlib.init_modules
let constant = gen_constant_in_modules "ZMicromega" coq_modules
let bin_constant = gen_constant_in_modules "ZMicromega" bin_module
let r_constant = gen_constant_in_modules "ZMicromega" r_modules
@@ -603,10 +599,10 @@ struct
let get_left_construct sigma term =
match EConstr.kind sigma term with
- | Constr.Construct((_,i),_) -> (i,[| |])
- | Constr.App(l,rst) ->
+ | Term.Construct((_,i),_) -> (i,[| |])
+ | Term.App(l,rst) ->
(match EConstr.kind sigma l with
- | Constr.Construct((_,i),_) -> (i,rst)
+ | Term.Construct((_,i),_) -> (i,rst)
| _ -> raise ParseError
)
| _ -> raise ParseError
@@ -627,7 +623,7 @@ struct
let rec dump_nat x =
match x with
| Mc.O -> Lazy.force coq_O
- | Mc.S p -> Term.mkApp(Lazy.force coq_S,[| dump_nat p |])
+ | Mc.S p -> EConstr.mkApp(Lazy.force coq_S,[| dump_nat p |])
let rec parse_positive sigma term =
let (i,c) = get_left_construct sigma term in
@@ -640,28 +636,28 @@ struct
let rec dump_positive x =
match x with
| Mc.XH -> Lazy.force coq_xH
- | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_positive p |])
- | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_positive p |])
+ | Mc.XO p -> EConstr.mkApp(Lazy.force coq_xO,[| dump_positive p |])
+ | Mc.XI p -> EConstr.mkApp(Lazy.force coq_xI,[| dump_positive p |])
let pp_positive o x = Printf.fprintf o "%i" (CoqToCaml.positive x)
let dump_n x =
match x with
| Mc.N0 -> Lazy.force coq_N0
- | Mc.Npos p -> Term.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
+ | Mc.Npos p -> EConstr.mkApp(Lazy.force coq_Npos,[| dump_positive p|])
let rec dump_index x =
match x with
| Mc.XH -> Lazy.force coq_xH
- | Mc.XO p -> Term.mkApp(Lazy.force coq_xO,[| dump_index p |])
- | Mc.XI p -> Term.mkApp(Lazy.force coq_xI,[| dump_index p |])
+ | Mc.XO p -> EConstr.mkApp(Lazy.force coq_xO,[| dump_index p |])
+ | Mc.XI p -> EConstr.mkApp(Lazy.force coq_xI,[| dump_index p |])
let pp_index o x = Printf.fprintf o "%i" (CoqToCaml.index x)
let pp_n o x = output_string o (string_of_int (CoqToCaml.n x))
let dump_pair t1 t2 dump_t1 dump_t2 (x,y) =
- Term.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
+ EConstr.mkApp(Lazy.force coq_pair,[| t1 ; t2 ; dump_t1 x ; dump_t2 y|])
let parse_z sigma term =
let (i,c) = get_left_construct sigma term in
@@ -674,23 +670,23 @@ struct
let dump_z x =
match x with
| Mc.Z0 ->Lazy.force coq_ZERO
- | Mc.Zpos p -> Term.mkApp(Lazy.force coq_POS,[| dump_positive p|])
- | Mc.Zneg p -> Term.mkApp(Lazy.force coq_NEG,[| dump_positive p|])
+ | Mc.Zpos p -> EConstr.mkApp(Lazy.force coq_POS,[| dump_positive p|])
+ | Mc.Zneg p -> EConstr.mkApp(Lazy.force coq_NEG,[| dump_positive p|])
let pp_z o x = Printf.fprintf o "%s" (Big_int.string_of_big_int (CoqToCaml.z_big_int x))
let dump_num bd1 =
- Term.mkApp(Lazy.force coq_Qmake,
- [|dump_z (CamlToCoq.bigint (numerator bd1)) ;
- dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
+ EConstr.mkApp(Lazy.force coq_Qmake,
+ [|dump_z (CamlToCoq.bigint (numerator bd1)) ;
+ dump_positive (CamlToCoq.positive_big_int (denominator bd1)) |])
let dump_q q =
- Term.mkApp(Lazy.force coq_Qmake,
- [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
+ EConstr.mkApp(Lazy.force coq_Qmake,
+ [| dump_z q.Micromega.qnum ; dump_positive q.Micromega.qden|])
let parse_q sigma term =
match EConstr.kind sigma term with
- | Constr.App(c, args) -> if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then
+ | Term.App(c, args) -> if EConstr.eq_constr sigma c (Lazy.force coq_Qmake) then
{Mc.qnum = parse_z sigma args.(0) ; Mc.qden = parse_positive sigma args.(1) }
else raise ParseError
| _ -> raise ParseError
@@ -713,13 +709,13 @@ struct
match cst with
| Mc.C0 -> Lazy.force coq_C0
| Mc.C1 -> Lazy.force coq_C1
- | Mc.CQ q -> Term.mkApp(Lazy.force coq_CQ, [| dump_q q |])
- | Mc.CZ z -> Term.mkApp(Lazy.force coq_CZ, [| dump_z z |])
- | Mc.CPlus(x,y) -> Term.mkApp(Lazy.force coq_CPlus, [| dump_Rcst x ; dump_Rcst y |])
- | Mc.CMinus(x,y) -> Term.mkApp(Lazy.force coq_CMinus, [| dump_Rcst x ; dump_Rcst y |])
- | Mc.CMult(x,y) -> Term.mkApp(Lazy.force coq_CMult, [| dump_Rcst x ; dump_Rcst y |])
- | Mc.CInv t -> Term.mkApp(Lazy.force coq_CInv, [| dump_Rcst t |])
- | Mc.COpp t -> Term.mkApp(Lazy.force coq_COpp, [| dump_Rcst t |])
+ | Mc.CQ q -> EConstr.mkApp(Lazy.force coq_CQ, [| dump_q q |])
+ | Mc.CZ z -> EConstr.mkApp(Lazy.force coq_CZ, [| dump_z z |])
+ | Mc.CPlus(x,y) -> EConstr.mkApp(Lazy.force coq_CPlus, [| dump_Rcst x ; dump_Rcst y |])
+ | Mc.CMinus(x,y) -> EConstr.mkApp(Lazy.force coq_CMinus, [| dump_Rcst x ; dump_Rcst y |])
+ | Mc.CMult(x,y) -> EConstr.mkApp(Lazy.force coq_CMult, [| dump_Rcst x ; dump_Rcst y |])
+ | Mc.CInv t -> EConstr.mkApp(Lazy.force coq_CInv, [| dump_Rcst t |])
+ | Mc.COpp t -> EConstr.mkApp(Lazy.force coq_COpp, [| dump_Rcst t |])
let rec parse_Rcst sigma term =
let (i,c) = get_left_construct sigma term in
@@ -746,8 +742,8 @@ struct
let rec dump_list typ dump_elt l =
match l with
- | [] -> Term.mkApp(Lazy.force coq_nil,[| typ |])
- | e :: l -> Term.mkApp(Lazy.force coq_cons,
+ | [] -> EConstr.mkApp(Lazy.force coq_nil,[| typ |])
+ | e :: l -> EConstr.mkApp(Lazy.force coq_cons,
[| typ; dump_elt e;dump_list typ dump_elt l|])
let pp_list op cl elt o l =
@@ -777,27 +773,27 @@ struct
let dump_expr typ dump_z e =
let rec dump_expr e =
match e with
- | Mc.PEX n -> mkApp(Lazy.force coq_PEX,[| typ; dump_var n |])
- | Mc.PEc z -> mkApp(Lazy.force coq_PEc,[| typ ; dump_z z |])
- | Mc.PEadd(e1,e2) -> mkApp(Lazy.force coq_PEadd,
- [| typ; dump_expr e1;dump_expr e2|])
- | Mc.PEsub(e1,e2) -> mkApp(Lazy.force coq_PEsub,
- [| typ; dump_expr e1;dump_expr e2|])
- | Mc.PEopp e -> mkApp(Lazy.force coq_PEopp,
- [| typ; dump_expr e|])
- | Mc.PEmul(e1,e2) -> mkApp(Lazy.force coq_PEmul,
- [| typ; dump_expr e1;dump_expr e2|])
- | Mc.PEpow(e,n) -> mkApp(Lazy.force coq_PEpow,
- [| typ; dump_expr e; dump_n n|])
+ | Mc.PEX n -> EConstr.mkApp(Lazy.force coq_PEX,[| typ; dump_var n |])
+ | Mc.PEc z -> EConstr.mkApp(Lazy.force coq_PEc,[| typ ; dump_z z |])
+ | Mc.PEadd(e1,e2) -> EConstr.mkApp(Lazy.force coq_PEadd,
+ [| typ; dump_expr e1;dump_expr e2|])
+ | Mc.PEsub(e1,e2) -> EConstr.mkApp(Lazy.force coq_PEsub,
+ [| typ; dump_expr e1;dump_expr e2|])
+ | Mc.PEopp e -> EConstr.mkApp(Lazy.force coq_PEopp,
+ [| typ; dump_expr e|])
+ | Mc.PEmul(e1,e2) -> EConstr.mkApp(Lazy.force coq_PEmul,
+ [| typ; dump_expr e1;dump_expr e2|])
+ | Mc.PEpow(e,n) -> EConstr.mkApp(Lazy.force coq_PEpow,
+ [| typ; dump_expr e; dump_n n|])
in
dump_expr e
let dump_pol typ dump_c e =
let rec dump_pol e =
match e with
- | Mc.Pc n -> mkApp(Lazy.force coq_Pc, [|typ ; dump_c n|])
- | Mc.Pinj(p,pol) -> mkApp(Lazy.force coq_Pinj , [| typ ; dump_positive p ; dump_pol pol|])
- | Mc.PX(pol1,p,pol2) -> mkApp(Lazy.force coq_PX, [| typ ; dump_pol pol1 ; dump_positive p ; dump_pol pol2|]) in
+ | Mc.Pc n -> EConstr.mkApp(Lazy.force coq_Pc, [|typ ; dump_c n|])
+ | Mc.Pinj(p,pol) -> EConstr.mkApp(Lazy.force coq_Pinj , [| typ ; dump_positive p ; dump_pol pol|])
+ | Mc.PX(pol1,p,pol2) -> EConstr.mkApp(Lazy.force coq_PX, [| typ ; dump_pol pol1 ; dump_positive p ; dump_pol pol2|]) in
dump_pol e
let pp_pol pp_c o e =
@@ -816,17 +812,17 @@ struct
let z = Lazy.force typ in
let rec dump_cone e =
match e with
- | Mc.PsatzIn n -> mkApp(Lazy.force coq_PsatzIn,[| z; dump_nat n |])
- | Mc.PsatzMulC(e,c) -> mkApp(Lazy.force coq_PsatzMultC,
- [| z; dump_pol z dump_z e ; dump_cone c |])
- | Mc.PsatzSquare e -> mkApp(Lazy.force coq_PsatzSquare,
- [| z;dump_pol z dump_z e|])
- | Mc.PsatzAdd(e1,e2) -> mkApp(Lazy.force coq_PsatzAdd,
- [| z; dump_cone e1; dump_cone e2|])
- | Mc.PsatzMulE(e1,e2) -> mkApp(Lazy.force coq_PsatzMulE,
- [| z; dump_cone e1; dump_cone e2|])
- | Mc.PsatzC p -> mkApp(Lazy.force coq_PsatzC,[| z; dump_z p|])
- | Mc.PsatzZ -> mkApp( Lazy.force coq_PsatzZ,[| z|]) in
+ | Mc.PsatzIn n -> EConstr.mkApp(Lazy.force coq_PsatzIn,[| z; dump_nat n |])
+ | Mc.PsatzMulC(e,c) -> EConstr.mkApp(Lazy.force coq_PsatzMultC,
+ [| z; dump_pol z dump_z e ; dump_cone c |])
+ | Mc.PsatzSquare e -> EConstr.mkApp(Lazy.force coq_PsatzSquare,
+ [| z;dump_pol z dump_z e|])
+ | Mc.PsatzAdd(e1,e2) -> EConstr.mkApp(Lazy.force coq_PsatzAdd,
+ [| z; dump_cone e1; dump_cone e2|])
+ | Mc.PsatzMulE(e1,e2) -> EConstr.mkApp(Lazy.force coq_PsatzMulE,
+ [| z; dump_cone e1; dump_cone e2|])
+ | Mc.PsatzC p -> EConstr.mkApp(Lazy.force coq_PsatzC,[| z; dump_z p|])
+ | Mc.PsatzZ -> EConstr.mkApp(Lazy.force coq_PsatzZ,[| z|]) in
dump_cone e
let pp_psatz pp_z o e =
@@ -869,10 +865,10 @@ struct
Printf.fprintf o"(%a %a %a)" (pp_expr pp_z) l pp_op op (pp_expr pp_z) r
let dump_cstr typ dump_constant {Mc.flhs = e1 ; Mc.fop = o ; Mc.frhs = e2} =
- Term.mkApp(Lazy.force coq_Build,
- [| typ; dump_expr typ dump_constant e1 ;
- dump_op o ;
- dump_expr typ dump_constant e2|])
+ EConstr.mkApp(Lazy.force coq_Build,
+ [| typ; dump_expr typ dump_constant e1 ;
+ dump_op o ;
+ dump_expr typ dump_constant e2|])
let assoc_const sigma x l =
try
@@ -906,8 +902,8 @@ struct
let parse_zop gl (op,args) =
let sigma = gl.sigma in
match EConstr.kind sigma op with
- | Const (x,_) -> (assoc_const sigma op zop_table, args.(0) , args.(1))
- | Ind((n,0),_) ->
+ | Term.Const (x,_) -> (assoc_const sigma op zop_table, args.(0) , args.(1))
+ | Term.Ind((n,0),_) ->
if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_Z)
then (Mc.OpEq, args.(1), args.(2))
else raise ParseError
@@ -916,8 +912,8 @@ struct
let parse_rop gl (op,args) =
let sigma = gl.sigma in
match EConstr.kind sigma op with
- | Const (x,_) -> (assoc_const sigma op rop_table, args.(0) , args.(1))
- | Ind((n,0),_) ->
+ | Term.Const (x,_) -> (assoc_const sigma op rop_table, args.(0) , args.(1))
+ | Term.Ind((n,0),_) ->
if EConstr.eq_constr sigma op (Lazy.force coq_Eq) && is_convertible gl args.(0) (Lazy.force coq_R)
then (Mc.OpEq, args.(1), args.(2))
else raise ParseError
@@ -928,7 +924,7 @@ struct
let is_constant sigma t = (* This is an approx *)
match EConstr.kind sigma t with
- | Construct(i,_) -> true
+ | Term.Construct(i,_) -> true
| _ -> false
type 'a op =
@@ -949,14 +945,14 @@ struct
module Env =
struct
- type t = constr list
+ type t = EConstr.constr list
let compute_rank_add env sigma v =
let rec _add env n v =
match env with
| [] -> ([v],n)
| e::l ->
- if eq_constr sigma e v
+ if EConstr.eq_constr sigma e v
then (env,n)
else
let (env,n) = _add l ( n+1) v in
@@ -970,7 +966,7 @@ struct
match env with
| [] -> raise (Invalid_argument "get_rank")
| e::l ->
- if eq_constr sigma e v
+ if EConstr.eq_constr sigma e v
then n
else _get_rank l (n+1) in
_get_rank env 1
@@ -1011,10 +1007,10 @@ struct
try (Mc.PEc (parse_constant term) , env)
with ParseError ->
match EConstr.kind sigma term with
- | App(t,args) ->
+ | Term.App(t,args) ->
(
match EConstr.kind sigma t with
- | Const c ->
+ | Term.Const c ->
( match assoc_ops sigma t ops_spec with
| Binop f -> combine env f (args.(0),args.(1))
| Opp -> let (expr,env) = parse_expr env args.(0) in
@@ -1077,13 +1073,13 @@ struct
let rec rconstant sigma term =
match EConstr.kind sigma term with
- | Const x ->
+ | Term.Const x ->
if EConstr.eq_constr sigma term (Lazy.force coq_R0)
then Mc.C0
else if EConstr.eq_constr sigma term (Lazy.force coq_R1)
then Mc.C1
else raise ParseError
- | App(op,args) ->
+ | Term.App(op,args) ->
begin
try
(* the evaluation order is important in the following *)
@@ -1152,7 +1148,7 @@ struct
if debug
then Feedback.msg_debug (Pp.str "parse_arith: " ++ Printer.pr_leconstr cstr ++ fnl ());
match EConstr.kind sigma cstr with
- | App(op,args) ->
+ | Term.App(op,args) ->
let (op,lhs,rhs) = parse_op gl (op,args) in
let (e1,env) = parse_expr sigma env lhs in
let (e2,env) = parse_expr sigma env rhs in
@@ -1207,29 +1203,29 @@ struct
let rec xparse_formula env tg term =
match EConstr.kind sigma term with
- | App(l,rst) ->
+ | Term.App(l,rst) ->
(match rst with
- | [|a;b|] when eq_constr sigma l (Lazy.force coq_and) ->
+ | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_and) ->
let f,env,tg = xparse_formula env tg a in
let g,env, tg = xparse_formula env tg b in
mkformula_binary mkC term f g,env,tg
- | [|a;b|] when eq_constr sigma l (Lazy.force coq_or) ->
+ | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_or) ->
let f,env,tg = xparse_formula env tg a in
let g,env,tg = xparse_formula env tg b in
mkformula_binary mkD term f g,env,tg
- | [|a|] when eq_constr sigma l (Lazy.force coq_not) ->
+ | [|a|] when EConstr.eq_constr sigma l (Lazy.force coq_not) ->
let (f,env,tg) = xparse_formula env tg a in (N(f), env,tg)
- | [|a;b|] when eq_constr sigma l (Lazy.force coq_iff) ->
+ | [|a;b|] when EConstr.eq_constr sigma l (Lazy.force coq_iff) ->
let f,env,tg = xparse_formula env tg a in
let g,env,tg = xparse_formula env tg b in
mkformula_binary mkIff term f g,env,tg
| _ -> parse_atom env tg term)
- | Prod(typ,a,b) when Vars.noccurn sigma 1 b ->
+ | Term.Prod(typ,a,b) when EConstr.Vars.noccurn sigma 1 b ->
let f,env,tg = xparse_formula env tg a in
let g,env,tg = xparse_formula env tg b in
mkformula_binary mkI term f g,env,tg
- | _ when eq_constr sigma term (Lazy.force coq_True) -> (TT,env,tg)
- | _ when eq_constr sigma term (Lazy.force coq_False) -> (FF,env,tg)
+ | _ when EConstr.eq_constr sigma term (Lazy.force coq_True) -> (TT,env,tg)
+ | _ when EConstr.eq_constr sigma term (Lazy.force coq_False) -> (FF,env,tg)
| _ when is_prop term -> X(term),env,tg
| _ -> raise ParseError
in
@@ -1238,14 +1234,14 @@ struct
let dump_formula typ dump_atom f =
let rec xdump f =
match f with
- | TT -> mkApp(Lazy.force coq_TT,[|typ|])
- | FF -> mkApp(Lazy.force coq_FF,[|typ|])
- | C(x,y) -> mkApp(Lazy.force coq_And,[|typ ; xdump x ; xdump y|])
- | D(x,y) -> mkApp(Lazy.force coq_Or,[|typ ; xdump x ; xdump y|])
- | I(x,_,y) -> mkApp(Lazy.force coq_Impl,[|typ ; xdump x ; xdump y|])
- | N(x) -> mkApp(Lazy.force coq_Neg,[|typ ; xdump x|])
- | A(x,_,_) -> mkApp(Lazy.force coq_Atom,[|typ ; dump_atom x|])
- | X(t) -> mkApp(Lazy.force coq_X,[|typ ; t|]) in
+ | TT -> EConstr.mkApp(Lazy.force coq_TT,[|typ|])
+ | FF -> EConstr.mkApp(Lazy.force coq_FF,[|typ|])
+ | C(x,y) -> EConstr.mkApp(Lazy.force coq_And,[|typ ; xdump x ; xdump y|])
+ | D(x,y) -> EConstr.mkApp(Lazy.force coq_Or,[|typ ; xdump x ; xdump y|])
+ | I(x,_,y) -> EConstr.mkApp(Lazy.force coq_Impl,[|typ ; xdump x ; xdump y|])
+ | N(x) -> EConstr.mkApp(Lazy.force coq_Neg,[|typ ; xdump x|])
+ | A(x,_,_) -> EConstr.mkApp(Lazy.force coq_Atom,[|typ ; dump_atom x|])
+ | X(t) -> EConstr.mkApp(Lazy.force coq_X,[|typ ; t|]) in
xdump f
@@ -1285,15 +1281,15 @@ struct
type 'cst dump_expr = (* 'cst is the type of the syntactic constants *)
{
- interp_typ : constr;
- dump_cst : 'cst -> constr;
- dump_add : constr;
- dump_sub : constr;
- dump_opp : constr;
- dump_mul : constr;
- dump_pow : constr;
- dump_pow_arg : Mc.n -> constr;
- dump_op : (Mc.op2 * Term.constr) list
+ interp_typ : EConstr.constr;
+ dump_cst : 'cst -> EConstr.constr;
+ dump_add : EConstr.constr;
+ dump_sub : EConstr.constr;
+ dump_opp : EConstr.constr;
+ dump_mul : EConstr.constr;
+ dump_pow : EConstr.constr;
+ dump_pow_arg : Mc.n -> EConstr.constr;
+ dump_op : (Mc.op2 * EConstr.constr) list
}
let dump_zexpr = lazy
@@ -1327,8 +1323,8 @@ let dump_qexpr = lazy
let add = Lazy.force coq_Rplus in
let one = Lazy.force coq_R1 in
- let mk_add x y = mkApp(add,[|x;y|]) in
- let mk_mult x y = mkApp(mult,[|x;y|]) in
+ let mk_add x y = EConstr.mkApp(add,[|x;y|]) in
+ let mk_mult x y = EConstr.mkApp(mult,[|x;y|]) in
let two = mk_add one one in
@@ -1351,13 +1347,13 @@ let rec dump_Rcst_as_R cst =
match cst with
| Mc.C0 -> Lazy.force coq_R0
| Mc.C1 -> Lazy.force coq_R1
- | Mc.CQ q -> Term.mkApp(Lazy.force coq_IQR, [| dump_q q |])
- | Mc.CZ z -> Term.mkApp(Lazy.force coq_IZR, [| dump_z z |])
- | Mc.CPlus(x,y) -> Term.mkApp(Lazy.force coq_Rplus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
- | Mc.CMinus(x,y) -> Term.mkApp(Lazy.force coq_Rminus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
- | Mc.CMult(x,y) -> Term.mkApp(Lazy.force coq_Rmult, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
- | Mc.CInv t -> Term.mkApp(Lazy.force coq_Rinv, [| dump_Rcst_as_R t |])
- | Mc.COpp t -> Term.mkApp(Lazy.force coq_Ropp, [| dump_Rcst_as_R t |])
+ | Mc.CQ q -> EConstr.mkApp(Lazy.force coq_IQR, [| dump_q q |])
+ | Mc.CZ z -> EConstr.mkApp(Lazy.force coq_IZR, [| dump_z z |])
+ | Mc.CPlus(x,y) -> EConstr.mkApp(Lazy.force coq_Rplus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+ | Mc.CMinus(x,y) -> EConstr.mkApp(Lazy.force coq_Rminus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+ | Mc.CMult(x,y) -> EConstr.mkApp(Lazy.force coq_Rmult, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+ | Mc.CInv t -> EConstr.mkApp(Lazy.force coq_Rinv, [| dump_Rcst_as_R t |])
+ | Mc.COpp t -> EConstr.mkApp(Lazy.force coq_Ropp, [| dump_Rcst_as_R t |])
let dump_rexpr = lazy
@@ -1386,7 +1382,7 @@ let dump_rexpr = lazy
let prodn n env b =
let rec prodrec = function
| (0, env, b) -> b
- | (n, ((v,t)::l), b) -> prodrec (n-1, l, mkProd (v,t,b))
+ | (n, ((v,t)::l), b) -> prodrec (n-1, l, EConstr.mkProd (v,t,b))
| _ -> assert false
in
prodrec (n,env,b)
@@ -1400,32 +1396,32 @@ let make_goal_of_formula sigma dexpr form =
let props = prop_env_of_formula sigma form in
- let vars_n = List.map (fun (_,i) -> (Names.id_of_string (Printf.sprintf "__x%i" i)) , dexpr.interp_typ) vars_idx in
- let props_n = List.mapi (fun i _ -> (Names.id_of_string (Printf.sprintf "__p%i" (i+1))) , Term.mkProp) props in
+ let vars_n = List.map (fun (_,i) -> (Names.Id.of_string (Printf.sprintf "__x%i" i)) , dexpr.interp_typ) vars_idx in
+ let props_n = List.mapi (fun i _ -> (Names.Id.of_string (Printf.sprintf "__p%i" (i+1))) , EConstr.mkProp) props in
let var_name_pos = List.map2 (fun (idx,_) (id,_) -> id,idx) vars_idx vars_n in
let dump_expr i e =
let rec dump_expr = function
- | Mc.PEX n -> mkRel (i+(List.assoc (CoqToCaml.positive n) vars_idx))
+ | Mc.PEX n -> EConstr.mkRel (i+(List.assoc (CoqToCaml.positive n) vars_idx))
| Mc.PEc z -> dexpr.dump_cst z
- | Mc.PEadd(e1,e2) -> mkApp(dexpr.dump_add,
+ | Mc.PEadd(e1,e2) -> EConstr.mkApp(dexpr.dump_add,
[| dump_expr e1;dump_expr e2|])
- | Mc.PEsub(e1,e2) -> mkApp(dexpr.dump_sub,
+ | Mc.PEsub(e1,e2) -> EConstr.mkApp(dexpr.dump_sub,
[| dump_expr e1;dump_expr e2|])
- | Mc.PEopp e -> mkApp(dexpr.dump_opp,
- [| dump_expr e|])
- | Mc.PEmul(e1,e2) -> mkApp(dexpr.dump_mul,
- [| dump_expr e1;dump_expr e2|])
- | Mc.PEpow(e,n) -> mkApp(dexpr.dump_pow,
- [| dump_expr e; dexpr.dump_pow_arg n|])
+ | Mc.PEopp e -> EConstr.mkApp(dexpr.dump_opp,
+ [| dump_expr e|])
+ | Mc.PEmul(e1,e2) -> EConstr.mkApp(dexpr.dump_mul,
+ [| dump_expr e1;dump_expr e2|])
+ | Mc.PEpow(e,n) -> EConstr.mkApp(dexpr.dump_pow,
+ [| dump_expr e; dexpr.dump_pow_arg n|])
in dump_expr e in
let mkop op e1 e2 =
try
- Term.mkApp(List.assoc op dexpr.dump_op, [| e1; e2|])
+ EConstr.mkApp(List.assoc op dexpr.dump_op, [| e1; e2|])
with Not_found ->
- Term.mkApp(Lazy.force coq_Eq,[|dexpr.interp_typ ; e1 ;e2|]) in
+ EConstr.mkApp(Lazy.force coq_Eq,[|dexpr.interp_typ ; e1 ;e2|]) in
let dump_cstr i { Mc.flhs ; Mc.fop ; Mc.frhs } =
mkop fop (dump_expr i flhs) (dump_expr i frhs) in
@@ -1434,13 +1430,13 @@ let make_goal_of_formula sigma dexpr form =
match f with
| TT -> Lazy.force coq_True
| FF -> Lazy.force coq_False
- | C(x,y) -> mkApp(Lazy.force coq_and,[|xdump pi xi x ; xdump pi xi y|])
- | D(x,y) -> mkApp(Lazy.force coq_or,[| xdump pi xi x ; xdump pi xi y|])
- | I(x,_,y) -> mkArrow (xdump pi xi x) (xdump (pi+1) (xi+1) y)
- | N(x) -> mkArrow (xdump pi xi x) (Lazy.force coq_False)
+ | C(x,y) -> EConstr.mkApp(Lazy.force coq_and,[|xdump pi xi x ; xdump pi xi y|])
+ | D(x,y) -> EConstr.mkApp(Lazy.force coq_or,[| xdump pi xi x ; xdump pi xi y|])
+ | I(x,_,y) -> EConstr.mkArrow (xdump pi xi x) (xdump (pi+1) (xi+1) y)
+ | N(x) -> EConstr.mkArrow (xdump pi xi x) (Lazy.force coq_False)
| A(x,_,_) -> dump_cstr xi x
| X(t) -> let idx = Env.get_rank props sigma t in
- mkRel (pi+idx) in
+ EConstr.mkRel (pi+idx) in
let nb_vars = List.length vars_n in
let nb_props = List.length props_n in
@@ -1449,12 +1445,12 @@ let make_goal_of_formula sigma dexpr form =
let subst_prop p =
let idx = Env.get_rank props sigma p in
- mkVar (Names.id_of_string (Printf.sprintf "__p%i" idx)) in
+ EConstr.mkVar (Names.Id.of_string (Printf.sprintf "__p%i" idx)) in
let form' = map_prop subst_prop form in
- (prodn nb_props (List.map (fun (x,y) -> Names.Name x,y) props_n)
- (prodn nb_vars (List.map (fun (x,y) -> Names.Name x,y) vars_n)
+ (prodn nb_props (List.map (fun (x,y) -> Name.Name x,y) props_n)
+ (prodn nb_vars (List.map (fun (x,y) -> Name.Name x,y) vars_n)
(xdump (List.length vars_n) 0 form)),
List.rev props_n, List.rev var_name_pos,form')
@@ -1469,7 +1465,7 @@ let make_goal_of_formula sigma dexpr form =
| [] -> acc
| (e::l) ->
let (name,expr,typ) = e in
- xset (Term.mkNamedLetIn
+ xset (EConstr.mkNamedLetIn
(Names.Id.of_string name)
expr typ acc) l in
xset concl l
@@ -1529,26 +1525,26 @@ let rec apply_ids t ids =
| i::ids -> apply_ids (Term.mkApp(t,[| Term.mkVar i |])) ids
let coq_Node =
- lazy (EConstr.of_constr (Coqlib.gen_constant_in_modules "VarMap"
- [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Node"))
+ lazy (gen_constant_in_modules "VarMap"
+ [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Node")
let coq_Leaf =
- lazy (EConstr.of_constr (Coqlib.gen_constant_in_modules "VarMap"
- [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Leaf"))
+ lazy (gen_constant_in_modules "VarMap"
+ [["Coq" ; "micromega" ; "VarMap"];["VarMap"]] "Leaf")
let coq_Empty =
- lazy (EConstr.of_constr (Coqlib.gen_constant_in_modules "VarMap"
- [["Coq" ; "micromega" ;"VarMap"];["VarMap"]] "Empty"))
+ lazy (gen_constant_in_modules "VarMap"
+ [["Coq" ; "micromega" ;"VarMap"];["VarMap"]] "Empty")
let coq_VarMap =
- lazy (EConstr.of_constr (Coqlib.gen_constant_in_modules "VarMap"
- [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t"))
+ lazy (gen_constant_in_modules "VarMap"
+ [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t")
let rec dump_varmap typ m =
match m with
- | Mc.Empty -> Term.mkApp(Lazy.force coq_Empty,[| typ |])
- | Mc.Leaf v -> Term.mkApp(Lazy.force coq_Leaf,[| typ; v|])
+ | Mc.Empty -> EConstr.mkApp(Lazy.force coq_Empty,[| typ |])
+ | Mc.Leaf v -> EConstr.mkApp(Lazy.force coq_Leaf,[| typ; v|])
| Mc.Node(l,o,r) ->
- Term.mkApp (Lazy.force coq_Node, [| typ; dump_varmap typ l; o ; dump_varmap typ r |])
+ EConstr.mkApp (Lazy.force coq_Node, [| typ; dump_varmap typ l; o ; dump_varmap typ r |])
let vm_of_list env =
@@ -1570,15 +1566,15 @@ let rec pp_varmap o vm =
let rec dump_proof_term = function
| Micromega.DoneProof -> Lazy.force coq_doneProof
| Micromega.RatProof(cone,rst) ->
- Term.mkApp(Lazy.force coq_ratProof, [| dump_psatz coq_Z dump_z cone; dump_proof_term rst|])
+ EConstr.mkApp(Lazy.force coq_ratProof, [| dump_psatz coq_Z dump_z cone; dump_proof_term rst|])
| Micromega.CutProof(cone,prf) ->
- Term.mkApp(Lazy.force coq_cutProof,
+ EConstr.mkApp(Lazy.force coq_cutProof,
[| dump_psatz coq_Z dump_z cone ;
dump_proof_term prf|])
| Micromega.EnumProof(c1,c2,prfs) ->
- Term.mkApp (Lazy.force coq_enumProof,
- [| dump_psatz coq_Z dump_z c1 ; dump_psatz coq_Z dump_z c2 ;
- dump_list (Lazy.force coq_proofTerm) dump_proof_term prfs |])
+ EConstr.mkApp (Lazy.force coq_enumProof,
+ [| dump_psatz coq_Z dump_z c1 ; dump_psatz coq_Z dump_z c2 ;
+ dump_list (Lazy.force coq_proofTerm) dump_proof_term prfs |])
let rec size_of_psatz = function
@@ -1638,11 +1634,11 @@ let parse_goal gl parse_arith env hyps term =
* The datastructures that aggregate theory-dependent proof values.
*)
type ('synt_c, 'prf) domain_spec = {
- typ : Term.constr; (* is the type of the interpretation domain - Z, Q, R*)
- coeff : Term.constr ; (* is the type of the syntactic coeffs - Z , Q , Rcst *)
- dump_coeff : 'synt_c -> Term.constr ;
- proof_typ : Term.constr ;
- dump_proof : 'prf -> Term.constr
+ typ : EConstr.constr; (* is the type of the interpretation domain - Z, Q, R*)
+ coeff : EConstr.constr ; (* is the type of the syntactic coeffs - Z , Q , Rcst *)
+ dump_coeff : 'synt_c -> EConstr.constr ;
+ proof_typ : EConstr.constr ;
+ dump_proof : 'prf -> EConstr.constr
}
let zz_domain_spec = lazy {
@@ -1669,8 +1665,6 @@ let rcst_domain_spec = lazy {
dump_proof = dump_psatz coq_Q dump_q
}
-open Proofview.Notations
-
(** Naive topological sort of constr according to the subterm-ordering *)
(* An element is minimal x is minimal w.r.t y if
@@ -1709,23 +1703,23 @@ let topo_sort_constr l =
let micromega_order_change spec cert cert_typ env ff (*: unit Proofview.tactic*) =
(* let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__v"^(string_of_int i)))) 0 env in *)
- let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[|spec.coeff|])) in
+ let formula_typ = (EConstr.mkApp (Lazy.force coq_Cstr,[|spec.coeff|])) in
let ff = dump_formula formula_typ (dump_cstr spec.coeff spec.dump_coeff) ff in
let vm = dump_varmap (spec.typ) (vm_of_list env) in
(* todo : directly generate the proof term - or generalize before conversion? *)
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+ Proofview.Goal.nf_enter begin fun gl ->
Tacticals.New.tclTHENLIST
[
Tactics.change_concl
(set
[
- ("__ff", ff, Term.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
- ("__varmap", vm, Term.mkApp(Lazy.force coq_VarMap, [|spec.typ|]));
+ ("__ff", ff, EConstr.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
+ ("__varmap", vm, EConstr.mkApp(Lazy.force coq_VarMap, [|spec.typ|]));
("__wit", cert, cert_typ)
]
(Tacmach.New.pf_concl gl))
]
- end }
+ end
(**
@@ -1844,20 +1838,20 @@ let abstract_formula hyps f =
| A(a,t,term) -> if TagSet.mem t hyps then A(a,t,term) else X(term)
| C(f1,f2) ->
(match xabs f1 , xabs f2 with
- | X a1 , X a2 -> X (Term.mkApp(Lazy.force coq_and, [|a1;a2|]))
+ | X a1 , X a2 -> X (EConstr.mkApp(Lazy.force coq_and, [|a1;a2|]))
| f1 , f2 -> C(f1,f2) )
| D(f1,f2) ->
(match xabs f1 , xabs f2 with
- | X a1 , X a2 -> X (Term.mkApp(Lazy.force coq_or, [|a1;a2|]))
+ | X a1 , X a2 -> X (EConstr.mkApp(Lazy.force coq_or, [|a1;a2|]))
| f1 , f2 -> D(f1,f2) )
| N(f) ->
(match xabs f with
- | X a -> X (Term.mkApp(Lazy.force coq_not, [|a|]))
+ | X a -> X (EConstr.mkApp(Lazy.force coq_not, [|a|]))
| f -> N f)
| I(f1,hyp,f2) ->
(match xabs f1 , hyp, xabs f2 with
| X a1 , Some _ , af2 -> af2
- | X a1 , None , X a2 -> X (Term.mkArrow a1 a2)
+ | X a1 , None , X a2 -> X (EConstr.mkArrow a1 a2)
| af1 , _ , af2 -> I(af1,hyp,af2)
)
| FF -> FF
@@ -1911,7 +1905,7 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
if debug then
begin
Feedback.msg_notice (Pp.str "Formula....\n") ;
- let formula_typ = (Term.mkApp(Lazy.force coq_Cstr, [|spec.coeff|])) in
+ let formula_typ = (EConstr.mkApp(Lazy.force coq_Cstr, [|spec.coeff|])) in
let ff = dump_formula formula_typ
(dump_cstr spec.typ spec.dump_coeff) ff in
Feedback.msg_notice (Printer.pr_leconstr ff);
@@ -1936,7 +1930,7 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
if debug then
begin
Feedback.msg_notice (Pp.str "\nAFormula\n") ;
- let formula_typ = (Term.mkApp( Lazy.force coq_Cstr,[| spec.coeff|])) in
+ let formula_typ = (EConstr.mkApp( Lazy.force coq_Cstr,[| spec.coeff|])) in
let ff' = dump_formula formula_typ
(dump_cstr spec.typ spec.dump_coeff) ff' in
Feedback.msg_notice (Printer.pr_leconstr ff');
@@ -1973,7 +1967,7 @@ let micromega_gen
(normalise:'cst atom -> 'cst mc_cnf)
unsat deduce
spec dumpexpr prover tac =
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+ Proofview.Goal.nf_enter begin fun gl ->
let sigma = Tacmach.New.project gl in
let concl = Tacmach.New.pf_concl gl in
let hyps = Tacmach.New.pf_hyps_types gl in
@@ -1994,11 +1988,11 @@ let micromega_gen
let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
let ipat_of_name id = Some (Loc.tag @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
let goal_name = fresh_id [] (Names.Id.of_string "__arith") gl in
- let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in
+ let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in
let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ;
micromega_order_change spec res'
- (Term.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env' ff_arith ] in
+ (EConstr.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env' ff_arith ] in
let goal_props = List.rev (prop_env_of_formula sigma ff') in
@@ -2017,8 +2011,8 @@ let micromega_gen
[
kill_arith;
(Tacticals.New.tclTHENLIST
- [(Tactics.generalize (List.map Term.mkVar ids));
- Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+ [(Tactics.generalize (List.map EConstr.mkVar ids));
+ Tactics.exact_check (EConstr.applist (EConstr.mkVar goal_name, arith_args))
] )
]
with
@@ -2030,7 +2024,7 @@ let micromega_gen
^ "the use of a specialized external tool called csdp. \n\n"
^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
- end }
+ end
let micromega_gen parse_arith
(negate:'cst atom -> 'cst mc_cnf)
@@ -2046,27 +2040,27 @@ let micromega_order_changer cert env ff =
let coeff = Lazy.force coq_Rcst in
let dump_coeff = dump_Rcst in
let typ = Lazy.force coq_R in
- let cert_typ = (Term.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
+ let cert_typ = (EConstr.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
- let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
+ let formula_typ = (EConstr.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
let ff = dump_formula formula_typ (dump_cstr coeff dump_coeff) ff in
let vm = dump_varmap (typ) (vm_of_list env) in
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+ Proofview.Goal.nf_enter begin fun gl ->
Tacticals.New.tclTHENLIST
[
(Tactics.change_concl
(set
[
- ("__ff", ff, Term.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
- ("__varmap", vm, Term.mkApp
- (EConstr.of_constr (Coqlib.gen_constant_in_modules "VarMap"
- [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t"), [|typ|]));
+ ("__ff", ff, EConstr.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
+ ("__varmap", vm, EConstr.mkApp
+ (gen_constant_in_modules "VarMap"
+ [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t", [|typ|]));
("__wit", cert, cert_typ)
]
(Tacmach.New.pf_concl gl)));
(* Tacticals.New.tclTHENLIST (List.map (fun id -> (Tactics.introduction id)) ids)*)
]
- end }
+ end
let micromega_genr prover tac =
let parse_arith = parse_rarith in
@@ -2081,7 +2075,7 @@ let micromega_genr prover tac =
proof_typ = Lazy.force coq_QWitness ;
dump_proof = dump_psatz coq_Q dump_q
} in
- Proofview.Goal.nf_enter { enter = begin fun gl ->
+ Proofview.Goal.nf_enter begin fun gl ->
let sigma = Tacmach.New.project gl in
let concl = Tacmach.New.pf_concl gl in
let hyps = Tacmach.New.pf_hyps_types gl in
@@ -2109,7 +2103,7 @@ let micromega_genr prover tac =
let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
let ipat_of_name id = Some (Loc.tag @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
let goal_name = fresh_id [] (Names.Id.of_string "__arith") gl in
- let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in
+ let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in
let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ;
micromega_order_changer res' env' ff_arith ] in
@@ -2131,8 +2125,8 @@ let micromega_genr prover tac =
[
kill_arith;
(Tacticals.New.tclTHENLIST
- [(Tactics.generalize (List.map Term.mkVar ids));
- Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+ [(Tactics.generalize (List.map EConstr.mkVar ids));
+ Tactics.exact_check (EConstr.applist (EConstr.mkVar goal_name, arith_args))
] )
]
@@ -2145,7 +2139,7 @@ let micromega_genr prover tac =
^ "the use of a specialized external tool called csdp. \n\n"
^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
- end }
+ end
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index ccb6daa116..d803c75549 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -16,6 +16,7 @@
(*i camlp4deps: "grammar/grammar.cma" i*)
+open API
open Ltac_plugin
open Stdarg
open Tacarg
diff --git a/plugins/micromega/micromega.ml b/plugins/micromega/micromega.ml
index 5cf1da8ea8..7da4a3b829 100644
--- a/plugins/micromega/micromega.ml
+++ b/plugins/micromega/micromega.ml
@@ -1,3 +1,4 @@
+
(** val negb : bool -> bool **)
let negb = function
@@ -34,8 +35,7 @@ module Coq__1 = struct
| O -> m
| S p -> S (add p m)
end
-let add = Coq__1.add
-
+include Coq__1
type positive =
| XI of positive
@@ -82,11 +82,10 @@ module Coq_Pos =
| XI q0 -> XI (add p q0)
| XO q0 -> XO (add p q0)
| XH -> XI p)
- | XH ->
- (match y with
- | XI q0 -> XO (succ q0)
- | XO q0 -> XI q0
- | XH -> XO XH)
+ | XH -> (match y with
+ | XI q0 -> XO (succ q0)
+ | XO q0 -> XI q0
+ | XH -> XO XH)
(** val add_carry : positive -> positive -> positive **)
@@ -154,10 +153,9 @@ module Coq_Pos =
| XI q0 -> succ_double_mask (sub_mask_carry p q0)
| XO q0 -> double_mask (sub_mask p q0)
| XH -> IsPos (pred_double p))
- | XH ->
- (match y with
- | XH -> IsNul
- | _ -> IsNeg)
+ | XH -> (match y with
+ | XH -> IsNul
+ | _ -> IsNeg)
(** val sub_mask_carry : positive -> positive -> mask **)
@@ -197,8 +195,7 @@ module Coq_Pos =
| XO p2 -> S (size_nat p2)
| XH -> S O
- (** val compare_cont :
- comparison -> positive -> positive -> comparison **)
+ (** val compare_cont : comparison -> positive -> positive -> comparison **)
let rec compare_cont r x y =
match x with
@@ -212,10 +209,9 @@ module Coq_Pos =
| XI q0 -> compare_cont Lt p q0
| XO q0 -> compare_cont r p q0
| XH -> Gt)
- | XH ->
- (match y with
- | XH -> r
- | _ -> Lt)
+ | XH -> (match y with
+ | XH -> r
+ | _ -> Lt)
(** val compare : positive -> positive -> comparison **)
@@ -277,14 +273,12 @@ let rec pow_pos rmul x = function
let rec nth n0 l default =
match n0 with
- | O ->
- (match l with
- | [] -> default
- | x::_ -> x)
- | S m ->
- (match l with
- | [] -> default
- | _::t0 -> nth m t0 default)
+ | O -> (match l with
+ | [] -> default
+ | x::_ -> x)
+ | S m -> (match l with
+ | [] -> default
+ | _::t0 -> nth m t0 default)
(** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **)
@@ -389,15 +383,13 @@ module Z =
let compare x y =
match x with
- | Z0 ->
- (match y with
- | Z0 -> Eq
- | Zpos _ -> Lt
- | Zneg _ -> Gt)
- | Zpos x' ->
- (match y with
- | Zpos y' -> Coq_Pos.compare x' y'
- | _ -> Gt)
+ | Z0 -> (match y with
+ | Z0 -> Eq
+ | Zpos _ -> Lt
+ | Zneg _ -> Gt)
+ | Zpos x' -> (match y with
+ | Zpos y' -> Coq_Pos.compare x' y'
+ | _ -> Gt)
| Zneg x' ->
(match y with
| Zneg y' -> compOpp (Coq_Pos.compare x' y')
@@ -533,10 +525,9 @@ let p1 cI =
let rec peq ceqb p p' =
match p with
- | Pc c ->
- (match p' with
- | Pc c' -> ceqb c c'
- | _ -> false)
+ | Pc c -> (match p' with
+ | Pc c' -> ceqb c c'
+ | _ -> false)
| Pinj (j, q0) ->
(match p' with
| Pinj (j', q') ->
@@ -568,8 +559,7 @@ let mkPinj_pred j p =
| XH -> p
(** val mkPX :
- 'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1
- pol **)
+ 'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
let mkPX cO ceqb p i q0 =
match p with
@@ -631,8 +621,8 @@ let rec paddI cadd pop q0 j = function
| XH -> PX (p2, i, (pop q' q0)))
(** val psubI :
- ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
- -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+ ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+ 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
let rec psubI cadd copp pop q0 j = function
| Pc c -> mkPinj j (paddC cadd (popp copp q0) c)
@@ -644,13 +634,12 @@ let rec psubI cadd copp pop q0 j = function
| PX (p2, i, q') ->
(match j with
| XI j0 -> PX (p2, i, (psubI cadd copp pop q0 (XO j0) q'))
- | XO j0 ->
- PX (p2, i, (psubI cadd copp pop q0 (Coq_Pos.pred_double j0) q'))
+ | XO j0 -> PX (p2, i, (psubI cadd copp pop q0 (Coq_Pos.pred_double j0) q'))
| XH -> PX (p2, i, (pop q' q0)))
(** val paddX :
- 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
- pol -> positive -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+ -> positive -> 'a1 pol -> 'a1 pol **)
let rec paddX cO ceqb pop p' i' p = match p with
| Pc _ -> PX (p', i', p)
@@ -666,16 +655,15 @@ let rec paddX cO ceqb pop p' i' p = match p with
| Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q')
(** val psubX :
- 'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
- 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+ pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
let rec psubX cO copp ceqb pop p' i' p = match p with
| Pc _ -> PX ((popp copp p'), i', p)
| Pinj (j, q') ->
(match j with
| XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q')))
- | XO j0 ->
- PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
+ | XO j0 -> PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
| XH -> PX ((popp copp p'), i', q'))
| PX (p2, i, q') ->
(match Z.pos_sub i i' with
@@ -684,8 +672,8 @@ let rec psubX cO copp ceqb pop p' i' p = match p with
| Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q')
(** val padd :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
- pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+ -> 'a1 pol **)
let rec padd cO cadd ceqb p = function
| Pc c' -> paddC cadd p c'
@@ -703,8 +691,7 @@ let rec padd cO cadd ceqb p = function
| PX (p2, i, q0) ->
(match Z.pos_sub i i' with
| Z0 ->
- mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i
- (padd cO cadd ceqb q0 q')
+ mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i (padd cO cadd ceqb q0 q')
| Zpos k ->
mkPX cO ceqb (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i'
(padd cO cadd ceqb q0 q')
@@ -713,8 +700,8 @@ let rec padd cO cadd ceqb p = function
(padd cO cadd ceqb q0 q')))
(** val psub :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
- ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+ -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
let rec psub cO cadd csub copp ceqb p = function
| Pc c' -> psubC csub p c'
@@ -729,39 +716,36 @@ let rec psub cO cadd csub copp ceqb p = function
(psub cO cadd csub copp ceqb (Pinj ((XO j0), q0)) q'))
| XO j0 ->
PX ((popp copp p'0), i',
- (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0),
- q0)) q'))
- | XH ->
- PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
+ (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
+ q'))
+ | XH -> PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
| PX (p2, i, q0) ->
(match Z.pos_sub i i' with
| Z0 ->
mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i
(psub cO cadd csub copp ceqb q0 q')
| Zpos k ->
- mkPX cO ceqb
- (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0) i'
- (psub cO cadd csub copp ceqb q0 q')
+ mkPX cO ceqb (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0)
+ i' (psub cO cadd csub copp ceqb q0 q')
| Zneg k ->
mkPX cO ceqb
(psubX cO copp ceqb (psub cO cadd csub copp ceqb) p'0 k p2) i
(psub cO cadd csub copp ceqb q0 q')))
(** val pmulC_aux :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
- -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
+ 'a1 pol **)
let rec pmulC_aux cO cmul ceqb p c =
match p with
| Pc c' -> Pc (cmul c' c)
| Pinj (j, q0) -> mkPinj j (pmulC_aux cO cmul ceqb q0 c)
| PX (p2, i, q0) ->
- mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i
- (pmulC_aux cO cmul ceqb q0 c)
+ mkPX cO ceqb (pmulC_aux cO cmul ceqb p2 c) i (pmulC_aux cO cmul ceqb q0 c)
(** val pmulC :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol
- -> 'a1 -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
+ 'a1 -> 'a1 pol **)
let pmulC cO cI cmul ceqb p c =
if ceqb c cO
@@ -769,8 +753,8 @@ let pmulC cO cI cmul ceqb p c =
else if ceqb c cI then p else pmulC_aux cO cmul ceqb p c
(** val pmulI :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol
- -> 'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
+ 'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
| Pc c -> mkPinj j (pmulC cO cI cmul ceqb q0 c)
@@ -791,13 +775,12 @@ let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 XH p') i' (pmul0 q' q0))
(** val pmul :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
| Pc c -> pmulC cO cI cmul ceqb p c
-| Pinj (j', q') ->
- pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
+| Pinj (j', q') -> pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
| PX (p', i', q') ->
(match p with
| Pc c -> pmulC cO cI cmul ceqb p'' c
@@ -806,24 +789,22 @@ let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
match j with
| XI j0 -> pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q0)) q'
| XO j0 ->
- pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
- q'
+ pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) q'
| XH -> pmul cO cI cadd cmul ceqb q0 q'
in
mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i' qQ'
| PX (p2, i, q0) ->
let qQ' = pmul cO cI cadd cmul ceqb q0 q' in
- let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2
- in
+ let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2 in
let qP' = pmul cO cI cadd cmul ceqb (mkPinj XH q0) p' in
let pP' = pmul cO cI cadd cmul ceqb p2 p' in
padd cO cadd ceqb
- (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP')
- i' (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
+ (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP') i'
+ (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
(** val psquare :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> 'a1 pol -> 'a1 pol **)
let rec psquare cO cI cadd cmul ceqb = function
| Pc c -> Pc (cmul c c)
@@ -852,9 +833,9 @@ let mk_X cO cI j =
mkPinj_pred j (mkX cO cI)
(** val ppow_pos :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive
- -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1
+ pol **)
let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
| XI p3 ->
@@ -868,17 +849,16 @@ let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
| XH -> subst_l (pmul cO cI cadd cmul ceqb res p)
(** val ppow_N :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
let ppow_N cO cI cadd cmul ceqb subst_l p = function
| N0 -> p1 cI
| Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2
(** val norm_aux :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
- 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
let rec norm_aux cO cI cadd cmul csub copp ceqb = function
| PEc c -> Pc c
@@ -899,8 +879,7 @@ let rec norm_aux cO cI cadd cmul csub copp ceqb = function
padd cO cadd ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
(norm_aux cO cI cadd cmul csub copp ceqb pe2)))
| PEsub (pe1, pe2) ->
- psub cO cadd csub copp ceqb
- (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+ psub cO cadd csub copp ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
(norm_aux cO cI cadd cmul csub copp ceqb pe2)
| PEmul (pe1, pe2) ->
pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
@@ -947,8 +926,8 @@ let ff =
[]::[]
(** val add_term :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause ->
- 'a1 clause option **)
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause -> 'a1
+ clause option **)
let rec add_term unsat deduce t0 = function
| [] ->
@@ -969,8 +948,8 @@ let rec add_term unsat deduce t0 = function
| None -> None))
(** val or_clause :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1
- clause -> 'a1 clause option **)
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
+ -> 'a1 clause option **)
let rec or_clause unsat deduce cl1 cl2 =
match cl1 with
@@ -981,8 +960,8 @@ let rec or_clause unsat deduce cl1 cl2 =
| None -> None)
(** val or_clause_cnf :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf
- -> 'a1 cnf **)
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
+ 'a1 cnf **)
let or_clause_cnf unsat deduce t0 f =
fold_right (fun e acc ->
@@ -991,8 +970,8 @@ let or_clause_cnf unsat deduce t0 f =
| None -> acc) [] f
(** val or_cnf :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf ->
- 'a1 cnf **)
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
+ cnf **)
let rec or_cnf unsat deduce f f' =
match f with
@@ -1006,8 +985,8 @@ let and_cnf f1 f2 =
app f1 f2
(** val xcnf :
- ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) ->
- ('a1 -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
+ ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+ -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
let rec xcnf unsat deduce normalise0 negate0 pol0 = function
| TT -> if pol0 then tt else ff
@@ -1047,9 +1026,9 @@ let rec cnf_checker checker f l =
| c::l0 -> if checker e c then cnf_checker checker f0 l0 else false)
(** val tauto_checker :
- ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) ->
- ('a1 -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3
- list -> bool **)
+ ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+ -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
+ bool **)
let tauto_checker unsat deduce normalise0 negate0 checker f w =
cnf_checker checker (xcnf unsat deduce normalise0 negate0 true f) w
@@ -1085,10 +1064,9 @@ let opMult o o' =
| Equal -> Some Equal
| NonEqual -> Some NonEqual
| _ -> None)
- | Strict ->
- (match o' with
- | NonEqual -> None
- | _ -> Some o')
+ | Strict -> (match o' with
+ | NonEqual -> None
+ | _ -> Some o')
| NonStrict ->
(match o' with
| Equal -> Some Equal
@@ -1100,14 +1078,12 @@ let opMult o o' =
let opAdd o o' =
match o with
| Equal -> Some o'
- | NonEqual ->
- (match o' with
- | Equal -> Some NonEqual
- | _ -> None)
- | Strict ->
- (match o' with
- | NonEqual -> None
- | _ -> Some Strict)
+ | NonEqual -> (match o' with
+ | Equal -> Some NonEqual
+ | _ -> None)
+ | Strict -> (match o' with
+ | NonEqual -> None
+ | _ -> Some Strict)
| NonStrict ->
(match o' with
| Equal -> Some NonStrict
@@ -1134,15 +1110,14 @@ let map_option f = function
let map_option2 f o o' =
match o with
- | Some x ->
- (match o' with
- | Some x' -> f x x'
- | None -> None)
+ | Some x -> (match o' with
+ | Some x' -> f x x'
+ | None -> None)
| None -> None
(** val pexpr_times_nformula :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
| ef,o ->
@@ -1151,8 +1126,8 @@ let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
| _ -> None)
(** val nformula_times_nformula :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
let e1,o1 = f1 in
@@ -1161,8 +1136,8 @@ let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
(opMult o1 o2)
(** val nformula_plus_nformula :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
- 'a1 nFormula -> 'a1 nFormula option **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+ nFormula -> 'a1 nFormula option **)
let nformula_plus_nformula cO cplus ceqb f1 f2 =
let e1,o1 = f1 in
@@ -1170,9 +1145,9 @@ let nformula_plus_nformula cO cplus ceqb f1 f2 =
map_option (fun x -> Some ((padd cO cplus ceqb e1 e2),x)) (opAdd o1 o2)
(** val eval_Psatz :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
- -> 'a1 nFormula option **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+ nFormula option **)
let rec eval_Psatz cO cI cplus ctimes ceqb cleb l = function
| PsatzIn n0 -> Some (nth n0 l ((Pc cO),Equal))
@@ -1207,9 +1182,8 @@ let check_inconsistent cO ceqb cleb = function
| _ -> false)
(** val check_normalised_formulas :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
- -> bool **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool **)
let check_normalised_formulas cO cI cplus ctimes ceqb cleb l cm =
match eval_Psatz cO cI cplus ctimes ceqb cleb l cm with
@@ -1227,31 +1201,30 @@ type op2 =
type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
(** val norm :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
- 'a1 pol **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
let norm cO cI cplus ctimes cminus copp ceqb =
norm_aux cO cI cplus ctimes cminus copp ceqb
(** val psub0 :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
- ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+ -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
let psub0 cO cplus cminus copp ceqb =
psub cO cplus cminus copp ceqb
(** val padd0 :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
- pol -> 'a1 pol **)
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+ -> 'a1 pol **)
let padd0 cO cplus ceqb =
padd cO cplus ceqb
(** val xnormalise :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
- 'a1 nFormula list **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+ nFormula list **)
let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
let { flhs = lhs; fop = o; frhs = rhs } = t0 in
@@ -1259,11 +1232,9 @@ let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
let rhs0 = norm cO cI cplus ctimes cminus copp ceqb rhs in
(match o with
| OpEq ->
- ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
- cplus
+ ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
cminus copp
- ceqb rhs0
- lhs0),Strict)::[])
+ ceqb rhs0 lhs0),Strict)::[])
| OpNEq -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal)::[]
| OpLe -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::[]
| OpGe -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),Strict)::[]
@@ -1271,17 +1242,17 @@ let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
| OpGt -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict)::[])
(** val cnf_normalise :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
- 'a1 nFormula cnf **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+ nFormula cnf **)
let cnf_normalise cO cI cplus ctimes cminus copp ceqb t0 =
map (fun x -> x::[]) (xnormalise cO cI cplus ctimes cminus copp ceqb t0)
(** val xnegate :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
- 'a1 nFormula list **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+ nFormula list **)
let xnegate cO cI cplus ctimes cminus copp ceqb t0 =
let { flhs = lhs; fop = o; frhs = rhs } = t0 in
@@ -1290,20 +1261,18 @@ let xnegate cO cI cplus ctimes cminus copp ceqb t0 =
(match o with
| OpEq -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal)::[]
| OpNEq ->
- ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
- cplus
+ ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
cminus copp
- ceqb rhs0
- lhs0),Strict)::[])
+ ceqb rhs0 lhs0),Strict)::[])
| OpLe -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict)::[]
| OpGe -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),NonStrict)::[]
| OpLt -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),Strict)::[]
| OpGt -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::[])
(** val cnf_negate :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
- 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
- 'a1 nFormula cnf **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+ -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+ nFormula cnf **)
let cnf_negate cO cI cplus ctimes cminus copp ceqb t0 =
map (fun x -> x::[]) (xnegate cO cI cplus ctimes cminus copp ceqb t0)
@@ -1340,8 +1309,8 @@ let map_Formula c_of_S f =
{ flhs = (map_PExpr c_of_S l); fop = o; frhs = (map_PExpr c_of_S r) }
(** val simpl_cone :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
- -> 'a1 psatz **)
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
+ 'a1 psatz **)
let simpl_cone cO cI ctimes ceqb e = match e with
| PsatzSquare t0 ->
@@ -1379,8 +1348,7 @@ let simpl_cone cO cI ctimes ceqb e = match e with
| PsatzC p2 -> PsatzMulE ((PsatzC (ctimes c p2)), x)
| _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2)))
| PsatzAdd (y, z0) ->
- PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c),
- z0)))
+ PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c), z0)))
| PsatzC c0 -> PsatzC (ctimes c c0)
| PsatzZ -> PsatzZ
| _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2))
@@ -1393,10 +1361,9 @@ let simpl_cone cO cI ctimes ceqb e = match e with
| PsatzAdd (t1, t2) ->
(match t1 with
| PsatzZ -> t2
- | _ ->
- (match t2 with
- | PsatzZ -> t1
- | _ -> PsatzAdd (t1, t2)))
+ | _ -> (match t2 with
+ | PsatzZ -> t1
+ | _ -> PsatzAdd (t1, t2)))
| _ -> e
type q = { qnum : z; qden : positive }
@@ -1422,8 +1389,7 @@ let qle_bool x y =
(** val qplus : q -> q -> q **)
let qplus x y =
- { qnum =
- (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
+ { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
qden = (Coq_Pos.mul x.qden y.qden) }
(** val qmult : q -> q -> q **)
@@ -1635,8 +1601,7 @@ let genCuttingPlane = function
then None
else Some ((makeCuttingPlane e),Equal)
| NonEqual -> Some ((e,Z0),op)
- | Strict ->
- Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
+ | Strict -> Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
| NonStrict -> Some ((makeCuttingPlane e),NonStrict))
(** val nformula_of_cutting_plane : ((z polC * z) * op1) -> z nFormula **)
@@ -1647,10 +1612,9 @@ let nformula_of_cutting_plane = function
(** val is_pol_Z0 : z polC -> bool **)
let is_pol_Z0 = function
-| Pc z0 ->
- (match z0 with
- | Z0 -> true
- | _ -> false)
+| Pc z0 -> (match z0 with
+ | Z0 -> true
+ | _ -> false)
| _ -> false
(** val eval_Psatz0 : z nFormula list -> zWitness -> z nFormula option **)
@@ -1730,8 +1694,8 @@ let qnormalise =
(** val qnegate : q formula -> q nFormula cnf **)
let qnegate =
- cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
- qplus qmult qminus qopp qeq_bool
+ cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
+ qmult qminus qopp qeq_bool
(** val qunsat : q nFormula -> bool **)
@@ -1789,8 +1753,8 @@ let rnormalise =
(** val rnegate : q formula -> q nFormula cnf **)
let rnegate =
- cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
- qplus qmult qminus qopp qeq_bool
+ cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
+ qmult qminus qopp qeq_bool
(** val runsat : q nFormula -> bool **)
diff --git a/plugins/micromega/micromega.mli b/plugins/micromega/micromega.mli
index beb042f49d..9619781786 100644
--- a/plugins/micromega/micromega.mli
+++ b/plugins/micromega/micromega.mli
@@ -1,3 +1,4 @@
+
val negb : bool -> bool
type nat =
@@ -168,44 +169,44 @@ val paddI :
positive -> 'a1 pol -> 'a1 pol
val psubI :
- ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
- -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+ ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
+ 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
val paddX :
- 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
- pol -> positive -> 'a1 pol -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
+ -> positive -> 'a1 pol -> 'a1 pol
val psubX :
- 'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
- 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
+ pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
val padd :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
- -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+ 'a1 pol
val psub :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
- ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+ -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
val pmulC_aux :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
- 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> 'a1
+ pol
val pmulC :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
- 'a1 -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+ -> 'a1 pol
val pmulI :
'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
val pmul :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
val psquare :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> 'a1 pol -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> 'a1 pol -> 'a1 pol
type 'c pExpr =
| PEc of 'c
@@ -219,17 +220,16 @@ type 'c pExpr =
val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol
val ppow_pos :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive ->
- 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 pol
val ppow_N :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
val norm_aux :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
type 'a bFormula =
| TT
@@ -256,34 +256,31 @@ val add_term :
clause option
val or_clause :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
- -> 'a1 clause option
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause ->
+ 'a1 clause option
val or_clause_cnf :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
- 'a1 cnf
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf -> 'a1
+ cnf
val or_cnf :
- ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
- cnf
+ ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1 cnf
val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
val xcnf :
- ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
- -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
+ ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+ 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
val cnf_checker : ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool
val tauto_checker :
- ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
- -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
- bool
+ ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
+ 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list -> bool
val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
-val cltb :
- ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
+val cltb : ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
type 'c polC = 'c pol
@@ -314,30 +311,28 @@ val map_option2 :
('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option
val pexpr_times_nformula :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
val nformula_times_nformula :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
val nformula_plus_nformula :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
- 'a1 nFormula -> 'a1 nFormula option
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
+ nFormula -> 'a1 nFormula option
val eval_Psatz :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
- 'a1 nFormula option
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
+ nFormula option
val check_inconsistent :
- 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
- bool
+ 'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> bool
val check_normalised_formulas :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
- bool
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool
type op2 =
| OpEq
@@ -350,36 +345,36 @@ type op2 =
type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
val norm :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
val psub0 :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
- ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
+ -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
val padd0 :
- 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
- -> 'a1 pol
+ 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
+ 'a1 pol
val xnormalise :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
- nFormula list
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+ list
val cnf_normalise :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
- nFormula cnf
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+ cnf
val xnegate :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
- nFormula list
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+ list
val cnf_negate :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
- -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
- nFormula cnf
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
+ 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
+ cnf
val xdenorm : positive -> 'a1 pol -> 'a1 pExpr
@@ -390,8 +385,8 @@ val map_PExpr : ('a2 -> 'a1) -> 'a2 pExpr -> 'a1 pExpr
val map_Formula : ('a2 -> 'a1) -> 'a2 formula -> 'a1 formula
val simpl_cone :
- 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
- -> 'a1 psatz
+ 'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
+ 'a1 psatz
type q = { qnum : z; qden : positive }
diff --git a/plugins/micromega/sos_types.mli b/plugins/micromega/sos_types.mli
new file mode 100644
index 0000000000..57c4e50cad
--- /dev/null
+++ b/plugins/micromega/sos_types.mli
@@ -0,0 +1,40 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(* The type of positivstellensatz -- used to communicate with sos *)
+
+type vname = string;;
+
+type term =
+| Zero
+| Const of Num.num
+| Var of vname
+| Inv of term
+| Opp of term
+| Add of (term * term)
+| Sub of (term * term)
+| Mul of (term * term)
+| Div of (term * term)
+| Pow of (term * int);;
+
+val output_term : out_channel -> term -> unit
+
+type positivstellensatz =
+ Axiom_eq of int
+ | Axiom_le of int
+ | Axiom_lt of int
+ | Rational_eq of Num.num
+ | Rational_le of Num.num
+ | Rational_lt of Num.num
+ | Square of term
+ | Monoid of int list
+ | Eqmul of term * positivstellensatz
+ | Sum of positivstellensatz * positivstellensatz
+ | Product of positivstellensatz * positivstellensatz;;
+
+val output_psatz : out_channel -> positivstellensatz -> unit
diff --git a/plugins/micromega/vo.itarget b/plugins/micromega/vo.itarget
deleted file mode 100644
index c9009ea4de..0000000000
--- a/plugins/micromega/vo.itarget
+++ /dev/null
@@ -1,15 +0,0 @@
-EnvRing.vo
-Env.vo
-OrderedRing.vo
-Psatz.vo
-QMicromega.vo
-Refl.vo
-RingMicromega.vo
-RMicromega.vo
-Tauto.vo
-VarMap.vo
-ZCoeff.vo
-ZMicromega.vo
-Lia.vo
-Lqa.vo
-Lra.vo
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-02 10:50:18 +0000