diff options
| -rw-r--r-- | pretyping/classops.ml | 2 | ||||
| -rw-r--r-- | toplevel/class.ml | 10 |
2 files changed, 10 insertions, 2 deletions
diff --git a/pretyping/classops.ml b/pretyping/classops.ml index 9041a0af4..7793216d5 100644 --- a/pretyping/classops.ml +++ b/pretyping/classops.ml @@ -61,6 +61,7 @@ let coe_info_typ_equal c1 c2 = let cl_typ_ord t1 t2 = match t1, t2 with | CL_SECVAR v1, CL_SECVAR v2 -> Id.compare v1 v2 | CL_CONST c1, CL_CONST c2 -> con_user_ord c1 c2 + | CL_PROJ c1, CL_PROJ c2 -> con_user_ord c1 c2 | CL_IND i1, CL_IND i2 -> ind_user_ord i1 i2 | _ -> Pervasives.compare t1 t2 (** OK *) @@ -472,6 +473,7 @@ let subst_coercion (subst, c) = let discharge_cl = function | CL_CONST kn -> CL_CONST (Lib.discharge_con kn) | CL_IND ind -> CL_IND (Lib.discharge_inductive ind) + | CL_PROJ p -> CL_PROJ (Lib.discharge_con p) | cl -> cl let discharge_coercion (_, c) = diff --git a/toplevel/class.ml b/toplevel/class.ml index a6591f0d3..6e95a930d 100644 --- a/toplevel/class.ml +++ b/toplevel/class.ml @@ -96,7 +96,9 @@ let uniform_cond nargs lt = aux (nargs,lt) let class_of_global = function - | ConstRef sp -> CL_CONST sp + | ConstRef sp -> + if Environ.is_projection sp (Global.env ()) + then CL_PROJ sp else CL_CONST sp | IndRef sp -> CL_IND sp | VarRef id -> CL_SECVAR id | ConstructRef _ as c -> @@ -140,7 +142,11 @@ let get_target t ind = if (ind > 1) then CL_FUN else - pi1 (find_class_type Evd.empty t) + match pi1 (find_class_type Evd.empty t) with + | CL_CONST p when Environ.is_projection p (Global.env ()) -> + CL_PROJ p + | x -> x + let prods_of t = let rec aux acc d = match kind_of_term d with |