aboutsummaryrefslogtreecommitdiff
path: root/pretyping/classops.ml
diff options
context:
space:
mode:
authorMaxime Dénès2019-04-05 01:44:59 +0200
committerMaxime Dénès2019-04-10 15:41:44 +0200
commitac5d50d405ad878b6899d483e64576de63d2d095 (patch)
tree6e933be829ba881d698d4cf5adda896fc6a4e680 /pretyping/classops.ml
parentdd672f839765c656a910ff8e07603858dbc8bc38 (diff)
Functionalize env in type classes
I had to reorganize the code a bit. The Context command moved to comAssumption, as it is not so related to type classes. We were able to remove a few hooks on the way.
Diffstat (limited to 'pretyping/classops.ml')
-rw-r--r--pretyping/classops.ml42
1 files changed, 21 insertions, 21 deletions
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 570c83a0da..20215029af 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -318,21 +318,21 @@ let warn_ambiguous_path =
(* add_coercion_in_graph : coe_index * cl_index * cl_index -> unit
coercion,source,target *)
-let different_class_params i =
+let different_class_params env i =
let ci = class_info_from_index i in
if (snd ci).cl_param > 0 then true
else
match fst ci with
- | CL_IND i -> Global.is_polymorphic (IndRef i)
- | CL_CONST c -> Global.is_polymorphic (ConstRef c)
+ | CL_IND i -> Environ.is_polymorphic env (IndRef i)
+ | CL_CONST c -> Environ.is_polymorphic env (ConstRef c)
| _ -> false
-let add_coercion_in_graph (ic,source,target) =
+let add_coercion_in_graph env (ic,source,target) =
let old_inheritance_graph = !inheritance_graph in
let ambig_paths =
(ref [] : ((cl_index * cl_index) * inheritance_path) list ref) in
let try_add_new_path (i,j as ij) p =
- if not (Bijint.Index.equal i j) || different_class_params i then
+ if not (Bijint.Index.equal i j) || different_class_params env i then
match lookup_path_between_class ij with
| q ->
if not (compare_path p q) then
@@ -386,29 +386,29 @@ let subst_coercion subst c =
(* Computation of the class arity *)
-let reference_arity_length ref =
- let t, _ = Typeops.type_of_global_in_context (Global.env ()) ref in
- List.length (fst (Reductionops.splay_arity (Global.env()) Evd.empty (EConstr.of_constr t))) (** FIXME *)
+let reference_arity_length env sigma ref =
+ let t, _ = Typeops.type_of_global_in_context env ref in
+ List.length (fst (Reductionops.splay_arity env sigma (EConstr.of_constr t)))
-let projection_arity_length p =
- let len = reference_arity_length (ConstRef (Projection.Repr.constant p)) in
+let projection_arity_length env sigma p =
+ let len = reference_arity_length env sigma (ConstRef (Projection.Repr.constant p)) in
len - Projection.Repr.npars p
-let class_params = function
+let class_params env sigma = function
| CL_FUN | CL_SORT -> 0
- | CL_CONST sp -> reference_arity_length (ConstRef sp)
- | CL_PROJ sp -> projection_arity_length sp
- | CL_SECVAR sp -> reference_arity_length (VarRef sp)
- | CL_IND sp -> reference_arity_length (IndRef sp)
+ | CL_CONST sp -> reference_arity_length env sigma (ConstRef sp)
+ | CL_PROJ sp -> projection_arity_length env sigma sp
+ | CL_SECVAR sp -> reference_arity_length env sigma (VarRef sp)
+ | CL_IND sp -> reference_arity_length env sigma (IndRef sp)
(* add_class : cl_typ -> locality_flag option -> bool -> unit *)
-let add_class cl =
- add_new_class cl { cl_param = class_params cl }
+let add_class env sigma cl =
+ add_new_class cl { cl_param = class_params env sigma cl }
-let declare_coercion c =
- let () = add_class c.coercion_source in
- let () = add_class c.coercion_target in
+let declare_coercion env sigma c =
+ let () = add_class env sigma c.coercion_source in
+ let () = add_class env sigma c.coercion_target in
let is, _ = class_info c.coercion_source in
let it, _ = class_info c.coercion_target in
let xf =
@@ -419,7 +419,7 @@ let declare_coercion c =
coe_param = c.coercion_params;
} in
let () = add_new_coercion c.coercion_type xf in
- add_coercion_in_graph (xf,is,it)
+ add_coercion_in_graph env (xf,is,it)
(* For printing purpose *)
let pr_cl_index = Bijint.Index.print