summaryrefslogtreecommitdiff
path: root/plugins/firstorder
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/firstorder')
-rw-r--r--plugins/firstorder/formula.ml2
-rw-r--r--plugins/firstorder/formula.mli8
-rw-r--r--plugins/firstorder/g_ground.ml43
-rw-r--r--plugins/firstorder/ground.ml16
-rw-r--r--plugins/firstorder/instances.ml7
-rw-r--r--plugins/firstorder/instances.mli4
-rw-r--r--plugins/firstorder/rules.ml4
-rw-r--r--plugins/firstorder/rules.mli9
-rw-r--r--plugins/firstorder/sequent.ml32
-rw-r--r--plugins/firstorder/sequent.mli22
-rw-r--r--plugins/firstorder/unify.ml6
11 files changed, 55 insertions, 58 deletions
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index 047fc9fb..a60a966c 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -211,7 +211,7 @@ type left_pattern=
| Lexists of pinductive
| LA of constr*left_arrow_pattern
-type t={id:global_reference;
+type t={id:GlobRef.t;
constr:constr;
pat:(left_pattern,right_pattern) sum;
atoms:atoms}
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 2962d923..e2c6f1c4 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -8,9 +8,9 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
+open Names
open Constr
open EConstr
-open Globnames
val qflag : bool ref
@@ -35,7 +35,7 @@ type atoms = {positive:constr list;negative:constr list}
type side = Hyp | Concl | Hint
-val dummy_id: global_reference
+val dummy_id: GlobRef.t
val build_atoms : Environ.env -> Evd.evar_map -> counter ->
side -> constr -> bool * atoms
@@ -65,13 +65,13 @@ type left_pattern=
| Lexists of pinductive
| LA of constr*left_arrow_pattern
-type t={id: global_reference;
+type t={id: GlobRef.t;
constr: constr;
pat: (left_pattern,right_pattern) sum;
atoms: atoms}
(*exception Is_atom of constr*)
-val build_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> types ->
+val build_formula : Environ.env -> Evd.evar_map -> side -> GlobRef.t -> types ->
counter -> (t,types) sum
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 30deb6f4..7e54bc8a 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -17,7 +17,6 @@ open Goptions
open Tacmach.New
open Tacticals.New
open Tacinterp
-open Libnames
open Stdarg
open Tacarg
open Pcoq.Prim
@@ -127,7 +126,7 @@ let normalize_evaluables=
open Genarg
open Ppconstr
open Printer
-let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_reference
+let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_qualid
let pr_firstorder_using_glob _ _ _ = Pptactic.pr_auto_using (pr_or_var (fun x -> pr_global (snd x)))
let pr_firstorder_using_typed _ _ _ = Pptactic.pr_auto_using pr_global
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index 4e3ba573..516b04ea 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -13,23 +13,21 @@ open Formula
open Sequent
open Rules
open Instances
-open Constr
open Tacmach.New
open Tacticals.New
+open Globnames
let update_flags ()=
- let predref=ref Names.Cpred.empty in
- let f coe=
- try
- let kn= fst (destConst (Classops.get_coercion_value coe)) in
- predref:=Names.Cpred.add kn !predref
- with DestKO -> ()
+ let f acc coe =
+ match coe.Classops.coe_value with
+ | ConstRef c -> Names.Cpred.add c acc
+ | _ -> acc
in
- List.iter f (Classops.coercions ());
+ let pred = List.fold_left f Names.Cpred.empty (Classops.coercions ()) in
red_flags:=
CClosure.RedFlags.red_add_transparent
CClosure.betaiotazeta
- (Names.Id.Pred.full,Names.Cpred.complement !predref)
+ (Names.Id.Pred.full,Names.Cpred.complement pred)
let ground_tac solver startseq =
Proofview.Goal.enter begin fun gl ->
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index e8c0b927..85f49395 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -22,7 +22,6 @@ open Reductionops
open Formula
open Sequent
open Names
-open Misctypes
open Context.Rel.Declaration
let compare_instance inst1 inst2=
@@ -43,7 +42,7 @@ let compare_gr id1 id2 =
module OrderedInstance=
struct
- type t=instance * Globnames.global_reference
+ type t=instance * GlobRef.t
let compare (inst1,id1) (inst2,id2)=
(compare_instance =? compare_gr) inst2 inst1 id2 id1
(* we want a __decreasing__ total order *)
@@ -184,12 +183,12 @@ let right_instance_tac inst continue seq=
[introf;
Proofview.Goal.enter begin fun gl ->
let id0 = List.nth (pf_ids_of_hyps gl) 0 in
- split (ImplicitBindings [mkVar id0])
+ split (Tactypes.ImplicitBindings [mkVar id0])
end;
tclSOLVE [wrap 0 true continue (deepen seq)]];
tclTRY assumption]
| Real ((0,t),_) ->
- (tclTHEN (split (ImplicitBindings [t]))
+ (tclTHEN (split (Tactypes.ImplicitBindings [t]))
(tclSOLVE [wrap 0 true continue (deepen seq)]))
| Real ((m,t),_) ->
tclFAIL 0 (Pp.str "not implemented ... yet")
diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli
index 61786ffd..9f9ade3a 100644
--- a/plugins/firstorder/instances.mli
+++ b/plugins/firstorder/instances.mli
@@ -8,13 +8,13 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open Globnames
+open Names
open Rules
val collect_quantified : Evd.evar_map -> Sequent.t -> Formula.t list * Sequent.t
val give_instances : Evd.evar_map -> Formula.t list -> Sequent.t ->
- (Unify.instance * global_reference) list
+ (Unify.instance * GlobRef.t) list
val quantified_tac : Formula.t list -> seqtac with_backtracking
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index cfcd6561..b13580bc 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -29,7 +29,7 @@ type tactic = unit Proofview.tactic
type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
-type lseqtac= global_reference -> seqtac
+type lseqtac= GlobRef.t -> seqtac
type 'a with_backtracking = tactic -> 'a
@@ -233,7 +233,7 @@ let ll_forall_tac prod backtrack id continue seq=
(* special for compatibility with old Intuition *)
-let constant str = Universes.constr_of_global
+let constant str = UnivGen.constr_of_global
@@ Coqlib.coq_reference "User" ["Init";"Logic"] str
let defined_connectives=lazy
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index 859388b3..924c2679 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -11,21 +11,20 @@
open Names
open Constr
open EConstr
-open Globnames
type tactic = unit Proofview.tactic
type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
-type lseqtac= global_reference -> seqtac
+type lseqtac= GlobRef.t -> seqtac
type 'a with_backtracking = tactic -> 'a
val wrap : int -> bool -> seqtac
-val basename_of_global: global_reference -> Id.t
+val basename_of_global: GlobRef.t -> Id.t
-val clear_global: global_reference -> tactic
+val clear_global: GlobRef.t -> tactic
val axiom_tac : constr -> Sequent.t -> tactic
@@ -41,7 +40,7 @@ val left_and_tac : pinductive -> lseqtac with_backtracking
val left_or_tac : pinductive -> lseqtac with_backtracking
-val left_false_tac : global_reference -> tactic
+val left_false_tac : GlobRef.t -> tactic
val ll_ind_tac : pinductive -> constr list -> lseqtac with_backtracking
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 28599179..2a527da9 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -8,13 +8,13 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-open EConstr
-open CErrors
open Util
+open Pp
+open CErrors
+open Names
+open EConstr
open Formula
open Unify
-open Globnames
-open Pp
let newcnt ()=
let cnt=ref (-1) in
@@ -56,7 +56,7 @@ struct
(priority e1.pat) - (priority e2.pat)
end
-type h_item = global_reference * (int*Constr.t) option
+type h_item = GlobRef.t * (int*Constr.t) option
module Hitem=
struct
@@ -77,17 +77,17 @@ module CM=Map.Make(Constr)
module History=Set.Make(Hitem)
let cm_add sigma typ nam cm=
- let typ = EConstr.to_constr sigma typ in
+ let typ = EConstr.to_constr ~abort_on_undefined_evars:false sigma typ in
try
let l=CM.find typ cm in CM.add typ (nam::l) cm
with
Not_found->CM.add typ [nam] cm
let cm_remove sigma typ nam cm=
- let typ = EConstr.to_constr sigma typ in
+ let typ = EConstr.to_constr ~abort_on_undefined_evars:false sigma typ in
try
let l=CM.find typ cm in
- let l0=List.filter (fun id-> not (Globnames.eq_gr id nam)) l in
+ let l0=List.filter (fun id-> not (GlobRef.equal id nam)) l in
match l0 with
[]->CM.remove typ cm
| _ ->CM.add typ l0 cm
@@ -97,7 +97,7 @@ module HP=Heap.Functional(OrderedFormula)
type t=
{redexes:HP.t;
- context:(global_reference list) CM.t;
+ context:(GlobRef.t list) CM.t;
latoms:constr list;
gl:types;
glatom:constr option;
@@ -117,7 +117,7 @@ let lookup sigma item seq=
let p (id2,o)=
match o with
None -> false
- | Some (m2, t2)-> Globnames.eq_gr id id2 && m2>m && more_general sigma (m2, EConstr.of_constr t2) (m, EConstr.of_constr t) in
+ | Some (m2, t2)-> GlobRef.equal id id2 && m2>m && more_general sigma (m2, EConstr.of_constr t2) (m, EConstr.of_constr t) in
History.exists p seq.history
let add_formula env sigma side nam t seq =
@@ -152,7 +152,7 @@ let re_add_formula_list sigma lf seq=
redexes=List.fold_right HP.add lf seq.redexes;
context=List.fold_right do_one lf seq.context}
-let find_left sigma t seq=List.hd (CM.find (EConstr.to_constr sigma t) seq.context)
+let find_left sigma t seq=List.hd (CM.find (EConstr.to_constr ~abort_on_undefined_evars:false sigma t) seq.context)
(*let rev_left seq=
try
@@ -187,9 +187,9 @@ let empty_seq depth=
let expand_constructor_hints =
List.map_append (function
- | IndRef ind ->
+ | GlobRef.IndRef ind ->
List.init (Inductiveops.nconstructors ind)
- (fun i -> ConstructRef (ind,i+1))
+ (fun i -> GlobRef.ConstructRef (ind,i+1))
| gr ->
[gr])
@@ -197,7 +197,7 @@ let extend_with_ref_list env sigma l seq =
let l = expand_constructor_hints l in
let f gr (seq, sigma) =
let sigma, c = Evd.fresh_global env sigma gr in
- let sigma, typ= Typing.type_of env sigma (EConstr.of_constr c) in
+ let sigma, typ= Typing.type_of env sigma c in
(add_formula env sigma Hyp gr typ seq, sigma) in
List.fold_right f l (seq, sigma)
@@ -229,7 +229,9 @@ let extend_with_auto_hints env sigma l seq =
let print_cmap map=
let print_entry c l s=
- let xc=Constrextern.extern_constr false (Global.env ()) Evd.empty (EConstr.of_constr c) in
+ let env = Global.env () in
+ let sigma = Evd.from_env env in
+ let xc=Constrextern.extern_constr false env sigma (EConstr.of_constr c) in
str "| " ++
prlist Printer.pr_global l ++
str " : " ++
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index c4ed3e21..709b278e 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -8,26 +8,26 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
+open Names
open EConstr
open Formula
-open Globnames
module CM: CSig.MapS with type key=Constr.t
-type h_item = global_reference * (int*Constr.t) option
+type h_item = GlobRef.t * (int*Constr.t) option
module History: Set.S with type elt = h_item
-val cm_add : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
- global_reference list CM.t
+val cm_add : Evd.evar_map -> constr -> GlobRef.t -> GlobRef.t list CM.t ->
+ GlobRef.t list CM.t
-val cm_remove : Evd.evar_map -> constr -> global_reference -> global_reference list CM.t ->
- global_reference list CM.t
+val cm_remove : Evd.evar_map -> constr -> GlobRef.t -> GlobRef.t list CM.t ->
+ GlobRef.t list CM.t
module HP: Heap.S with type elt=Formula.t
type t = {redexes:HP.t;
- context: global_reference list CM.t;
+ context: GlobRef.t list CM.t;
latoms:constr list;
gl:types;
glatom:constr option;
@@ -41,20 +41,20 @@ val record: h_item -> t -> t
val lookup: Evd.evar_map -> h_item -> t -> bool
-val add_formula : Environ.env -> Evd.evar_map -> side -> global_reference -> constr -> t -> t
+val add_formula : Environ.env -> Evd.evar_map -> side -> GlobRef.t -> constr -> t -> t
val re_add_formula_list : Evd.evar_map -> Formula.t list -> t -> t
-val find_left : Evd.evar_map -> constr -> t -> global_reference
+val find_left : Evd.evar_map -> constr -> t -> GlobRef.t
val take_formula : Evd.evar_map -> t -> Formula.t * t
val empty_seq : int -> t
-val extend_with_ref_list : Environ.env -> Evd.evar_map -> global_reference list ->
+val extend_with_ref_list : Environ.env -> Evd.evar_map -> GlobRef.t list ->
t -> t * Evd.evar_map
val extend_with_auto_hints : Environ.env -> Evd.evar_map -> Hints.hint_db_name list ->
t -> t * Evd.evar_map
-val print_cmap: global_reference list CM.t -> Pp.t
+val print_cmap: GlobRef.t list CM.t -> Pp.t
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index b869c04a..d63fe9d7 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -9,7 +9,7 @@
(************************************************************************)
open Util
-open Term
+open Constr
open EConstr
open Vars
open Termops
@@ -56,12 +56,12 @@ let unif evd t1 t2=
| Meta i,_ ->
let t=subst_meta !sigma nt2 in
if Int.Set.is_empty (free_rels evd t) &&
- not (dependent evd (EConstr.mkMeta i) t) then
+ not (occur_metavariable evd i t) then
bind i t else raise (UFAIL(nt1,nt2))
| _,Meta i ->
let t=subst_meta !sigma nt1 in
if Int.Set.is_empty (free_rels evd t) &&
- not (dependent evd (EConstr.mkMeta i) t) then
+ not (occur_metavariable evd i t) then
bind i t else raise (UFAIL(nt1,nt2))
| Cast(_,_,_),_->Queue.add (strip_outer_cast evd nt1,nt2) bige
| _,Cast(_,_,_)->Queue.add (nt1,strip_outer_cast evd nt2) bige
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-17 11:46:31 +0000