aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'kernel')
-rw-r--r--kernel/cClosure.ml11
-rw-r--r--kernel/constr.ml208
-rw-r--r--kernel/constr.mli106
-rw-r--r--kernel/indtypes.ml16
-rw-r--r--kernel/inductive.ml35
-rw-r--r--kernel/modops.ml4
-rw-r--r--kernel/names.ml2
-rw-r--r--kernel/names.mli1
-rw-r--r--kernel/reduction.ml33
-rw-r--r--kernel/term.ml204
-rw-r--r--kernel/term.mli54
11 files changed, 457 insertions, 217 deletions
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index e1b086b753..fa12e54068 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -480,7 +480,8 @@ let rec lft_fconstr n ft =
| FCoFix(cfx,e) -> {norm=Cstr; term=FCoFix(cfx,subs_shft(n,e))}
| FLIFT(k,m) -> lft_fconstr (n+k) m
| FLOCKED -> assert false
- | _ -> {norm=ft.norm; term=FLIFT(n,ft)}
+ | FFlex _ | FAtom _ | FCast _ | FApp _ | FProj _ | FCaseT _ | FProd _
+ | FLetIn _ | FEvar _ | FCLOS _ -> {norm=ft.norm; term=FLIFT(n,ft)}
let lift_fconstr k f =
if Int.equal k 0 then f else lft_fconstr k f
let lift_fconstr_vect k v =
@@ -958,7 +959,10 @@ let rec knr info m stk =
(match evar_value info.i_cache ev with
Some c -> knit info env c stk
| None -> (m,stk))
- | _ -> (m,stk)
+ | FLOCKED | FRel _ | FAtom _ | FCast _ | FFlex _ | FInd _ | FApp _ | FProj _
+ | FFix _ | FCoFix _ | FCaseT _ | FLambda _ | FProd _ | FLetIn _ | FLIFT _
+ | FCLOS _ -> (m, stk)
+
(* Computes the weak head normal form of a term *)
and kni info m stk =
@@ -1034,7 +1038,8 @@ and norm_head info m =
mkEvar(i, Array.map (fun a -> kl info (mk_clos env a)) args)
| FProj (p,c) ->
mkProj (p, kl info c)
- | t -> term_of_fconstr m
+ | FLOCKED | FRel _ | FAtom _ | FCast _ | FFlex _ | FInd _ | FConstruct _
+ | FApp _ | FCaseT _ | FLIFT _ | FCLOS _ -> term_of_fconstr m
(* Initialization and then normalization *)
diff --git a/kernel/constr.ml b/kernel/constr.ml
index cec00c04b3..5930cfadc6 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -233,7 +233,6 @@ let mkMeta n = Meta n
(* Constructs a Variable named id *)
let mkVar id = Var id
-
(************************************************************************)
(* kind_of_term = constructions as seen by the user *)
(************************************************************************)
@@ -250,6 +249,168 @@ let of_kind = function
| Cast (c, knd, t) -> mkCast (c, knd, t)
| k -> k
+(**********************************************************************)
+(* Non primitive term destructors *)
+(**********************************************************************)
+
+(* Destructor operations : partial functions
+ Raise [DestKO] if the const has not the expected form *)
+
+exception DestKO
+
+let isMeta c = match kind c with Meta _ -> true | _ -> false
+
+(* Destructs a type *)
+let isSort c = match kind c with
+ | Sort _ -> true
+ | _ -> false
+
+let rec isprop c = match kind c with
+ | Sort (Sorts.Prop _) -> true
+ | Cast (c,_,_) -> isprop c
+ | _ -> false
+
+let rec is_Prop c = match kind c with
+ | Sort (Sorts.Prop Sorts.Null) -> true
+ | Cast (c,_,_) -> is_Prop c
+ | _ -> false
+
+let rec is_Set c = match kind c with
+ | Sort (Sorts.Prop Sorts.Pos) -> true
+ | Cast (c,_,_) -> is_Set c
+ | _ -> false
+
+let rec is_Type c = match kind c with
+ | Sort (Sorts.Type _) -> true
+ | Cast (c,_,_) -> is_Type c
+ | _ -> false
+
+let is_small = Sorts.is_small
+let iskind c = isprop c || is_Type c
+
+(* Tests if an evar *)
+let isEvar c = match kind c with Evar _ -> true | _ -> false
+let isEvar_or_Meta c = match kind c with
+ | Evar _ | Meta _ -> true
+ | _ -> false
+
+let isCast c = match kind c with Cast _ -> true | _ -> false
+(* Tests if a de Bruijn index *)
+let isRel c = match kind c with Rel _ -> true | _ -> false
+let isRelN n c =
+ match kind c with Rel n' -> Int.equal n n' | _ -> false
+(* Tests if a variable *)
+let isVar c = match kind c with Var _ -> true | _ -> false
+let isVarId id c = match kind c with Var id' -> Id.equal id id' | _ -> false
+(* Tests if an inductive *)
+let isInd c = match kind c with Ind _ -> true | _ -> false
+let isProd c = match kind c with | Prod _ -> true | _ -> false
+let isLambda c = match kind c with | Lambda _ -> true | _ -> false
+let isLetIn c = match kind c with LetIn _ -> true | _ -> false
+let isApp c = match kind c with App _ -> true | _ -> false
+let isConst c = match kind c with Const _ -> true | _ -> false
+let isConstruct c = match kind c with Construct _ -> true | _ -> false
+let isCase c = match kind c with Case _ -> true | _ -> false
+let isProj c = match kind c with Proj _ -> true | _ -> false
+let isFix c = match kind c with Fix _ -> true | _ -> false
+let isCoFix c = match kind c with CoFix _ -> true | _ -> false
+
+(* Destructs a de Bruijn index *)
+let destRel c = match kind c with
+ | Rel n -> n
+ | _ -> raise DestKO
+
+(* Destructs an existential variable *)
+let destMeta c = match kind c with
+ | Meta n -> n
+ | _ -> raise DestKO
+
+(* Destructs a variable *)
+let destVar c = match kind c with
+ | Var id -> id
+ | _ -> raise DestKO
+
+let destSort c = match kind c with
+ | Sort s -> s
+ | _ -> raise DestKO
+
+(* Destructs a casted term *)
+let destCast c = match kind c with
+ | Cast (t1,k,t2) -> (t1,k,t2)
+ | _ -> raise DestKO
+
+(* Destructs the product (x:t1)t2 *)
+let destProd c = match kind c with
+ | Prod (x,t1,t2) -> (x,t1,t2)
+ | _ -> raise DestKO
+
+(* Destructs the abstraction [x:t1]t2 *)
+let destLambda c = match kind c with
+ | Lambda (x,t1,t2) -> (x,t1,t2)
+ | _ -> raise DestKO
+
+(* Destructs the let [x:=b:t1]t2 *)
+let destLetIn c = match kind c with
+ | LetIn (x,b,t1,t2) -> (x,b,t1,t2)
+ | _ -> raise DestKO
+
+(* Destructs an application *)
+let destApp c = match kind c with
+ | App (f,a) -> (f, a)
+ | _ -> raise DestKO
+
+(* Destructs a constant *)
+let destConst c = match kind c with
+ | Const kn -> kn
+ | _ -> raise DestKO
+
+(* Destructs an existential variable *)
+let destEvar c = match kind c with
+ | Evar (kn, a as r) -> r
+ | _ -> raise DestKO
+
+(* Destructs a (co)inductive type named kn *)
+let destInd c = match kind c with
+ | Ind (kn, a as r) -> r
+ | _ -> raise DestKO
+
+(* Destructs a constructor *)
+let destConstruct c = match kind c with
+ | Construct (kn, a as r) -> r
+ | _ -> raise DestKO
+
+(* Destructs a term <p>Case c of lc1 | lc2 .. | lcn end *)
+let destCase c = match kind c with
+ | Case (ci,p,c,v) -> (ci,p,c,v)
+ | _ -> raise DestKO
+
+let destProj c = match kind c with
+ | Proj (p, c) -> (p, c)
+ | _ -> raise DestKO
+
+let destFix c = match kind c with
+ | Fix fix -> fix
+ | _ -> raise DestKO
+
+let destCoFix c = match kind c with
+ | CoFix cofix -> cofix
+ | _ -> raise DestKO
+
+
+(******************************************************************)
+(* Flattening and unflattening of embedded applications and casts *)
+(******************************************************************)
+
+let decompose_app c =
+ match kind c with
+ | App (f,cl) -> (f, Array.to_list cl)
+ | _ -> (c,[])
+
+let decompose_appvect c =
+ match kind c with
+ | App (f,cl) -> (f, cl)
+ | _ -> (c,[||])
+
(****************************************************************************)
(* Functions to recur through subterms *)
(****************************************************************************)
@@ -513,6 +674,7 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
| Prod (_,t1,c1), Prod (_,t2,c2) -> eq t1 t2 && leq c1 c2
| Lambda (_,t1,c1), Lambda (_,t2,c2) -> eq t1 t2 && eq c1 c2
| LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> eq b1 b2 && eq t1 t2 && leq c1 c2
+ (* Why do we suddenly make a special case for Cast here? *)
| App (Cast(c1, _, _),l1), _ -> leq (mkApp (c1,l1)) t2
| _, App (Cast (c2, _, _),l2) -> leq t1 (mkApp (c2,l2))
| App (c1,l1), App (c2,l2) ->
@@ -530,7 +692,9 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
&& Array.equal_norefl eq tl1 tl2 && Array.equal_norefl eq bl1 bl2
| CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
Int.equal ln1 ln2 && Array.equal_norefl eq tl1 tl2 && Array.equal_norefl eq bl1 bl2
- | _ -> false
+ | (Rel _ | Meta _ | Var _ | Sort _ | Prod _ | Lambda _ | LetIn _ | App _
+ | Proj _ | Evar _ | Const _ | Ind _ | Construct _ | Case _ | Fix _
+ | CoFix _), _ -> false
(* [compare_head_gen_leq u s eq leq c1 c2] compare [c1] and [c2] using [eq] to compare
the immediate subterms of [c1] of [c2] for conversion if needed, [leq] for cumulativity,
@@ -650,9 +814,6 @@ let always_true _ _ = true
let rec eq_constr_nounivs m n =
(m == n) || compare_head_gen (fun _ -> always_true) always_true eq_constr_nounivs m n
-(** We only use this function over blocks! *)
-let tag t = Obj.tag (Obj.repr t)
-
let constr_ord_int f t1 t2 =
let (=?) f g i1 i2 j1 j2=
let c = f i1 i2 in
@@ -664,35 +825,50 @@ let constr_ord_int f t1 t2 =
((Array.compare Int.compare) =? Int.compare) a1 a2 i1 i2
in
match kind t1, kind t2 with
+ | Cast (c1,_,_), _ -> f c1 t2
+ | _, Cast (c2,_,_) -> f t1 c2
+ (* Why this special case? *)
+ | App (Cast(c1,_,_),l1), _ -> f (mkApp (c1,l1)) t2
+ | _, App (Cast(c2, _,_),l2) -> f t1 (mkApp (c2,l2))
| Rel n1, Rel n2 -> Int.compare n1 n2
- | Meta m1, Meta m2 -> Int.compare m1 m2
+ | Rel _, _ -> -1 | _, Rel _ -> 1
| Var id1, Var id2 -> Id.compare id1 id2
+ | Var _, _ -> -1 | _, Var _ -> 1
+ | Meta m1, Meta m2 -> Int.compare m1 m2
+ | Meta _, _ -> -1 | _, Meta _ -> 1
+ | Evar (e1,l1), Evar (e2,l2) ->
+ (Evar.compare =? (Array.compare f)) e1 e2 l1 l2
+ | Evar _, _ -> -1 | _, Evar _ -> 1
| Sort s1, Sort s2 -> Sorts.compare s1 s2
- | Cast (c1,_,_), _ -> f c1 t2
- | _, Cast (c2,_,_) -> f t1 c2
+ | Sort _, _ -> -1 | _, Sort _ -> 1
| Prod (_,t1,c1), Prod (_,t2,c2)
| Lambda (_,t1,c1), Lambda (_,t2,c2) ->
(f =? f) t1 t2 c1 c2
+ | Prod _, _ -> -1 | _, Prod _ -> 1
+ | Lambda _, _ -> -1 | _, Lambda _ -> 1
| LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) ->
((f =? f) ==? f) b1 b2 t1 t2 c1 c2
- | App (Cast(c1,_,_),l1), _ -> f (mkApp (c1,l1)) t2
- | _, App (Cast(c2, _,_),l2) -> f t1 (mkApp (c2,l2))
+ | LetIn _, _ -> -1 | _, LetIn _ -> 1
| App (c1,l1), App (c2,l2) -> (f =? (Array.compare f)) c1 c2 l1 l2
- | Proj (p1,c1), Proj (p2,c2) -> (Projection.compare =? f) p1 p2 c1 c2
- | Evar (e1,l1), Evar (e2,l2) ->
- (Evar.compare =? (Array.compare f)) e1 e2 l1 l2
+ | App _, _ -> -1 | _, App _ -> 1
| Const (c1,u1), Const (c2,u2) -> Constant.CanOrd.compare c1 c2
+ | Const _, _ -> -1 | _, Const _ -> 1
| Ind (ind1, u1), Ind (ind2, u2) -> ind_ord ind1 ind2
+ | Ind _, _ -> -1 | _, Ind _ -> 1
| Construct (ct1,u1), Construct (ct2,u2) -> constructor_ord ct1 ct2
+ | Construct _, _ -> -1 | _, Construct _ -> 1
| Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) ->
((f =? f) ==? (Array.compare f)) p1 p2 c1 c2 bl1 bl2
+ | Case _, _ -> -1 | _, Case _ -> 1
| Fix (ln1,(_,tl1,bl1)), Fix (ln2,(_,tl2,bl2)) ->
((fix_cmp =? (Array.compare f)) ==? (Array.compare f))
ln1 ln2 tl1 tl2 bl1 bl2
+ | Fix _, _ -> -1 | _, Fix _ -> 1
| CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
((Int.compare =? (Array.compare f)) ==? (Array.compare f))
ln1 ln2 tl1 tl2 bl1 bl2
- | t1, t2 -> Int.compare (tag t1) (tag t2)
+ | CoFix _, _ -> -1 | _, CoFix _ -> 1
+ | Proj (p1,c1), Proj (p2,c2) -> (Projection.compare =? f) p1 p2 c1 c2
let rec compare m n=
constr_ord_int compare m n
@@ -776,7 +952,9 @@ let hasheq t1 t2 =
&& array_eqeq lna1 lna2
&& array_eqeq tl1 tl2
&& array_eqeq bl1 bl2
- | _ -> false
+ | (Rel _ | Meta _ | Var _ | Sort _ | Cast _ | Prod _ | Lambda _ | LetIn _
+ | App _ | Proj _ | Evar _ | Const _ | Ind _ | Construct _ | Case _
+ | Fix _ | CoFix _), _ -> false
(** Note that the following Make has the side effect of creating
once and for all the table we'll use for hash-consing all constr *)
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 474ab38843..4c5ea9e95c 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -225,6 +225,110 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
val kind : constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term
val of_kind : (constr, types, Sorts.t, Univ.Instance.t) kind_of_term -> constr
+(** {6 Simple case analysis} *)
+val isRel : constr -> bool
+val isRelN : int -> constr -> bool
+val isVar : constr -> bool
+val isVarId : Id.t -> constr -> bool
+val isInd : constr -> bool
+val isEvar : constr -> bool
+val isMeta : constr -> bool
+val isEvar_or_Meta : constr -> bool
+val isSort : constr -> bool
+val isCast : constr -> bool
+val isApp : constr -> bool
+val isLambda : constr -> bool
+val isLetIn : constr -> bool
+val isProd : constr -> bool
+val isConst : constr -> bool
+val isConstruct : constr -> bool
+val isFix : constr -> bool
+val isCoFix : constr -> bool
+val isCase : constr -> bool
+val isProj : constr -> bool
+
+val is_Prop : constr -> bool
+val is_Set : constr -> bool
+val isprop : constr -> bool
+val is_Type : constr -> bool
+val iskind : constr -> bool
+val is_small : Sorts.t -> bool
+
+(** {6 Term destructors } *)
+(** Destructor operations are partial functions and
+ @raise DestKO if the term has not the expected form. *)
+
+exception DestKO
+
+(** Destructs a de Bruijn index *)
+val destRel : constr -> int
+
+(** Destructs an existential variable *)
+val destMeta : constr -> metavariable
+
+(** Destructs a variable *)
+val destVar : constr -> Id.t
+
+(** Destructs a sort. [is_Prop] recognizes the sort {% \textsf{%}Prop{% }%}, whether
+ [isprop] recognizes both {% \textsf{%}Prop{% }%} and {% \textsf{%}Set{% }%}. *)
+val destSort : constr -> Sorts.t
+
+(** Destructs a casted term *)
+val destCast : constr -> constr * cast_kind * constr
+
+(** Destructs the product {% $ %}(x:t_1)t_2{% $ %} *)
+val destProd : types -> Name.t * types * types
+
+(** Destructs the abstraction {% $ %}[x:t_1]t_2{% $ %} *)
+val destLambda : constr -> Name.t * types * constr
+
+(** Destructs the let {% $ %}[x:=b:t_1]t_2{% $ %} *)
+val destLetIn : constr -> Name.t * constr * types * constr
+
+(** Destructs an application *)
+val destApp : constr -> constr * constr array
+
+(** Decompose any term as an applicative term; the list of args can be empty *)
+val decompose_app : constr -> constr * constr list
+
+(** Same as [decompose_app], but returns an array. *)
+val decompose_appvect : constr -> constr * constr array
+
+(** Destructs a constant *)
+val destConst : constr -> Constant.t puniverses
+
+(** Destructs an existential variable *)
+val destEvar : constr -> existential
+
+(** Destructs a (co)inductive type *)
+val destInd : constr -> inductive puniverses
+
+(** Destructs a constructor *)
+val destConstruct : constr -> constructor puniverses
+
+(** Destructs a [match c as x in I args return P with ... |
+Ci(...yij...) => ti | ... end] (or [let (..y1i..) := c as x in I args
+return P in t1], or [if c then t1 else t2])
+@return [(info,c,fun args x => P,[|...|fun yij => ti| ...|])]
+where [info] is pretty-printing information *)
+val destCase : constr -> case_info * constr * constr * constr array
+
+(** Destructs a projection *)
+val destProj : constr -> projection * constr
+
+(** Destructs the {% $ %}i{% $ %}th function of the block
+ [Fixpoint f{_ 1} ctx{_ 1} = b{_ 1}
+ with f{_ 2} ctx{_ 2} = b{_ 2}
+ ...
+ with f{_ n} ctx{_ n} = b{_ n}],
+ where the length of the {% $ %}j{% $ %}th context is {% $ %}ij{% $ %}.
+*)
+val destFix : constr -> fixpoint
+
+val destCoFix : constr -> cofixpoint
+
+(** {6 Equality} *)
+
(** [equal a b] is true if [a] equals [b] modulo alpha, casts,
and application grouping *)
val equal : constr -> constr -> bool
@@ -344,7 +448,7 @@ val compare_head_gen_leq : (bool -> Univ.Instance.t -> Univ.Instance.t -> bool)
(constr -> constr -> bool) ->
(constr -> constr -> bool) ->
constr -> constr -> bool
-
+
(** {6 Hashconsing} *)
val hash : constr -> int
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index f4e611c191..083b0ae40f 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -56,7 +56,7 @@ let weaker_noccur_between env x nvars t =
else None
let is_constructor_head t =
- Term.isRel(fst(Term.decompose_app t))
+ isRel(fst(decompose_app t))
(************************************************************************)
(* Various well-formedness check for inductive declarations *)
@@ -135,7 +135,7 @@ let infos_and_sort env t =
| Prod (name,c1,c2) ->
let varj = infer_type env c1 in
let env1 = Environ.push_rel (LocalAssum (name,varj.utj_val)) env in
- let max = Universe.sup max (Term.univ_of_sort varj.utj_type) in
+ let max = Universe.sup max (Sorts.univ_of_sort varj.utj_type) in
aux env1 c2 max
| _ when is_constructor_head t -> max
| _ -> (* don't fail if not positive, it is tested later *) max
@@ -184,7 +184,7 @@ let cumulate_arity_large_levels env sign =
match d with
| LocalAssum (_,t) ->
let tj = infer_type env t in
- let u = Term.univ_of_sort tj.utj_type in
+ let u = Sorts.univ_of_sort tj.utj_type in
(Universe.sup u lev, push_rel d env)
| LocalDef _ ->
lev, push_rel d env)
@@ -351,7 +351,7 @@ let typecheck_inductive env mie =
| None -> clev
in
let full_polymorphic () =
- let defu = Term.univ_of_sort def_level in
+ let defu = Sorts.univ_of_sort def_level in
let is_natural =
type_in_type env || (UGraph.check_leq (universes env') infu defu)
in
@@ -555,7 +555,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
constructor [cn] has a type of the shape [… -> c … -> P], where,
more generally, the arrows may be dependent). *)
let rec check_pos (env, n, ntypes, ra_env as ienv) nmr c =
- let x,largs = Term.decompose_app (whd_all env c) in
+ let x,largs = decompose_app (whd_all env c) in
match kind x with
| Prod (na,b,d) ->
let () = assert (List.is_empty largs) in
@@ -663,7 +663,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
inductive type. *)
and check_constructors ienv check_head nmr c =
let rec check_constr_rec (env,n,ntypes,ra_env as ienv) nmr lrec c =
- let x,largs = Term.decompose_app (whd_all env c) in
+ let x,largs = decompose_app (whd_all env c) in
match kind x with
| Prod (na,b,d) ->
@@ -916,11 +916,11 @@ let build_inductive env prv iu env_ar paramsctxt kn isrecord isfinite inds nmr r
let ar = {template_param_levels = paramlevs; template_level = lev} in
TemplateArity ar, all_sorts
| RegularArity (info,ar,defs) ->
- let s = sort_of_univ defs in
+ let s = Sorts.sort_of_univ defs in
let kelim = allowed_sorts info s in
let ar = RegularArity
{ mind_user_arity = Vars.subst_univs_level_constr substunivs ar;
- mind_sort = sort_of_univ (Univ.subst_univs_level_universe substunivs defs); } in
+ mind_sort = Sorts.sort_of_univ (Univ.subst_univs_level_universe substunivs defs); } in
ar, kelim in
(* Assigning VM tags to constructors *)
let nconst, nblock = ref 0, ref 0 in
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index cb03a4d6bd..62aa9a2d7b 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -29,20 +29,20 @@ let lookup_mind_specif env (kn,tyi) =
(mib, mib.mind_packets.(tyi))
let find_rectype env c =
- let (t, l) = Term.decompose_app (whd_all env c) in
+ let (t, l) = decompose_app (whd_all env c) in
match kind t with
| Ind ind -> (ind, l)
| _ -> raise Not_found
let find_inductive env c =
- let (t, l) = Term.decompose_app (whd_all env c) in
+ let (t, l) = decompose_app (whd_all env c) in
match kind t with
| Ind ind
when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite <> Decl_kinds.CoFinite -> (ind, l)
| _ -> raise Not_found
let find_coinductive env c =
- let (t, l) = Term.decompose_app (whd_all env c) in
+ let (t, l) = decompose_app (whd_all env c) in
match kind t with
| Ind ind
when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite == Decl_kinds.CoFinite -> (ind, l)
@@ -354,7 +354,7 @@ let build_branches_type (ind,u) (_,mip as specif) params p =
let typi = full_constructor_instantiate (ind,u,specif,params) cty in
let (cstrsign,ccl) = Term.decompose_prod_assum typi in
let nargs = Context.Rel.length cstrsign in
- let (_,allargs) = Term.decompose_app ccl in
+ let (_,allargs) = decompose_app ccl in
let (lparams,vargs) = List.chop (inductive_params specif) allargs in
let cargs =
let cstr = ith_constructor_of_inductive ind (i+1) in
@@ -566,8 +566,8 @@ let check_inductive_codomain env p =
let env = push_rel_context absctx env in
let arctx, s = dest_prod_assum env ar in
let env = push_rel_context arctx env in
- let i,l' = Term.decompose_app (whd_all env s) in
- Term.isInd i
+ let i,l' = decompose_app (whd_all env s) in
+ isInd i
(* The following functions are almost duplicated from indtypes.ml, except
that they carry here a poorer environment (containing less information). *)
@@ -621,7 +621,7 @@ close to check_positive in indtypes.ml, but does no positivity check and does no
compute the number of recursive arguments. *)
let get_recargs_approx env tree ind args =
let rec build_recargs (env, ra_env as ienv) tree c =
- let x,largs = Term.decompose_app (whd_all env c) in
+ let x,largs = decompose_app (whd_all env c) in
match kind x with
| Prod (na,b,d) ->
assert (List.is_empty largs);
@@ -680,7 +680,7 @@ let get_recargs_approx env tree ind args =
and build_recargs_constructors ienv trees c =
let rec recargs_constr_rec (env,ra_env as ienv) trees lrec c =
- let x,largs = Term.decompose_app (whd_all env c) in
+ let x,largs = decompose_app (whd_all env c) in
match kind x with
| Prod (na,b,d) ->
@@ -709,7 +709,7 @@ let restrict_spec env spec p =
let env = push_rel_context absctx env in
let arctx, s = dest_prod_assum env ar in
let env = push_rel_context arctx env in
- let i,args = Term.decompose_app (whd_all env s) in
+ let i,args = decompose_app (whd_all env s) in
match kind i with
| Ind i ->
begin match spec with
@@ -730,7 +730,7 @@ let restrict_spec env spec p =
let rec subterm_specif renv stack t =
(* maybe reduction is not always necessary! *)
- let f,l = Term.decompose_app (whd_all renv.env t) in
+ let f,l = decompose_app (whd_all renv.env t) in
match kind f with
| Rel k -> subterm_var k renv
| Case (ci,p,c,lbr) ->
@@ -809,8 +809,11 @@ let rec subterm_specif renv stack t =
| Dead_code -> Dead_code
| Not_subterm -> Not_subterm)
+ | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _ | Ind _
+ | Construct _ | CoFix _ -> Not_subterm
+
+
(* Other terms are not subterms *)
- | _ -> Not_subterm
and lazy_subterm_specif renv stack t =
lazy (subterm_specif renv stack t)
@@ -863,7 +866,7 @@ let filter_stack_domain env ci p stack =
let d = LocalAssum (n,a) in
let ctx, a = dest_prod_assum env a in
let env = push_rel_context ctx env in
- let ty, args = Term.decompose_app (whd_all env a) in
+ let ty, args = decompose_app (whd_all env a) in
let elt = match kind ty with
| Ind ind ->
let spec' = stack_element_specif elt in
@@ -894,7 +897,7 @@ let check_one_fix renv recpos trees def =
(* if [t] does not make recursive calls, it is guarded: *)
if noccur_with_meta renv.rel_min nfi t then ()
else
- let (f,l) = Term.decompose_app (whd_betaiotazeta renv.env t) in
+ let (f,l) = decompose_app (whd_betaiotazeta renv.env t) in
match kind f with
| Rel p ->
(* Test if [p] is a fixpoint (recursive call) *)
@@ -1120,7 +1123,7 @@ let rec codomain_is_coind env c =
let check_one_cofix env nbfix def deftype =
let rec check_rec_call env alreadygrd n tree vlra t =
if not (noccur_with_meta n nbfix t) then
- let c,args = Term.decompose_app (whd_all env t) in
+ let c,args = decompose_app (whd_all env t) in
match kind c with
| Rel p when n <= p && p < n+nbfix ->
(* recursive call: must be guarded and no nested recursive
@@ -1193,8 +1196,8 @@ let check_one_cofix env nbfix def deftype =
| Meta _ -> ()
| Evar _ ->
List.iter (check_rec_call env alreadygrd n tree vlra) args
-
- | _ -> raise (CoFixGuardError (env,NotGuardedForm t)) in
+ | Rel _ | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _
+ | Ind _ | Fix _ | Proj _ -> raise (CoFixGuardError (env,NotGuardedForm t)) in
let ((mind, _),_) = codomain_is_coind env deftype in
let vlra = lookup_subterms env mind in
diff --git a/kernel/modops.ml b/kernel/modops.ml
index b1df1a1877..11e6be6598 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -266,9 +266,9 @@ let subst_structure subst = subst_structure subst do_delta_codom
(* lclrk : retroknowledge_action list, rkaction : retroknowledge action *)
let add_retroknowledge mp =
let perform rkaction env = match rkaction with
- |Retroknowledge.RKRegister (f, e) when (Term.isConst e || Term.isInd e) ->
+ | Retroknowledge.RKRegister (f, e) when (isConst e || isInd e) ->
Environ.register env f e
- |_ ->
+ | _ ->
CErrors.anomaly ~label:"Modops.add_retroknowledge"
(Pp.str "had to import an unsupported kind of term.")
in
diff --git a/kernel/names.ml b/kernel/names.ml
index cb27104d15..b02c0b8409 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -179,6 +179,8 @@ struct
| [] -> "<>"
| sl -> String.concat "." (List.rev_map Id.to_string sl)
+ let print dp = str (to_string dp)
+
let initial = [default_module_name]
module Hdir = Hashcons.Hlist(Id)
diff --git a/kernel/names.mli b/kernel/names.mli
index ba0637c8a0..709ebeb7fd 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -159,6 +159,7 @@ sig
val hcons : t -> t
(** Hashconsing of directory paths. *)
+ val print : t -> Pp.t
end
(** {6 Names of structure elements } *)
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index bf998933e3..41d6c05eb5 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -57,7 +57,9 @@ let compare_stack_shape stk1 stk2 =
Int.equal bal 0 (* && c1.ci_ind = c2.ci_ind *) && compare_rec 0 s1 s2
| (Zfix(_,a1)::s1, Zfix(_,a2)::s2) ->
Int.equal bal 0 && compare_rec 0 a1 a2 && compare_rec 0 s1 s2
- | (_,_) -> false in
+ | [], _ :: _
+ | (Zproj _ | ZcaseT _ | Zfix _) :: _, _ -> false
+ in
compare_rec 0 stk1 stk2
type lft_constr_stack_elt =
@@ -122,14 +124,17 @@ let nf_betaiota env t =
let whd_betaiotazeta env x =
match kind x with
- | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
+ | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
Prod _|Lambda _|Fix _|CoFix _) -> x
| App (c, _) ->
begin match kind c with
| Ind _ | Construct _ | Evar _ | Meta _ | Const _ -> x
- | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
+ | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+ | Case _ | Fix _ | CoFix _ | Proj _ ->
+ whd_val (create_clos_infos betaiotazeta env) (inject x)
end
- | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
+ | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ ->
+ whd_val (create_clos_infos betaiotazeta env) (inject x)
let whd_all env t =
match kind t with
@@ -138,9 +143,12 @@ let whd_all env t =
| App (c, _) ->
begin match kind c with
| Ind _ | Construct _ | Evar _ | Meta _ -> t
- | _ -> whd_val (create_clos_infos all env) (inject t)
+ | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+ | Const _ |Case _ | Fix _ | CoFix _ | Proj _ ->
+ whd_val (create_clos_infos all env) (inject t)
end
- | _ -> whd_val (create_clos_infos all env) (inject t)
+ | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ | Const _ | Var _ ->
+ whd_val (create_clos_infos all env) (inject t)
let whd_allnolet env t =
match kind t with
@@ -149,9 +157,12 @@ let whd_allnolet env t =
| App (c, _) ->
begin match kind c with
| Ind _ | Construct _ | Evar _ | Meta _ | LetIn _ -> t
- | _ -> whd_val (create_clos_infos allnolet env) (inject t)
+ | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | App _
+ | Const _ | Case _ | Fix _ | CoFix _ | Proj _ ->
+ whd_val (create_clos_infos allnolet env) (inject t)
end
- | _ -> whd_val (create_clos_infos allnolet env) (inject t)
+ | Rel _ | Cast _ | Case _ | Proj _ | Const _ | Var _ ->
+ whd_val (create_clos_infos allnolet env) (inject t)
(********************************************************************)
(* Conversion *)
@@ -578,10 +589,10 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
(* Should not happen because both (hd1,v1) and (hd2,v2) are in whnf *)
| ( (FLetIn _, _) | (FCaseT _,_) | (FApp _,_) | (FCLOS _,_) | (FLIFT _,_)
| (_, FLetIn _) | (_,FCaseT _) | (_,FApp _) | (_,FCLOS _) | (_,FLIFT _)
- | (FLOCKED,_) | (_,FLOCKED) ) -> assert false
+ | (FLOCKED,_) | (_,FLOCKED) ) | (FCast _, _) | (_, FCast _) -> assert false
- (* In all other cases, terms are not convertible *)
- | _ -> raise NotConvertible
+ | (FRel _ | FAtom _ | FInd _ | FFix _ | FCoFix _
+ | FProd _ | FEvar _), _ -> raise NotConvertible
and convert_stacks l2r infos lft1 lft2 stk1 stk2 cuniv =
compare_stacks
diff --git a/kernel/term.ml b/kernel/term.ml
index 1c970867a9..4217cfac79 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -11,6 +11,7 @@ open Pp
open CErrors
open Names
open Vars
+open Constr
(**********************************************************************)
(** Redeclaration of types from module Constr *)
@@ -165,167 +166,52 @@ let hcons_types = Constr.hcons
(* Non primitive term destructors *)
(**********************************************************************)
-(* Destructor operations : partial functions
- Raise [DestKO] if the const has not the expected form *)
-
-exception DestKO
-
+exception DestKO = DestKO
(* Destructs a de Bruijn index *)
-let destRel c = match kind_of_term c with
- | Rel n -> n
- | _ -> raise DestKO
-
-(* Destructs an existential variable *)
-let destMeta c = match kind_of_term c with
- | Meta n -> n
- | _ -> raise DestKO
-
-let isMeta c = match kind_of_term c with Meta _ -> true | _ -> false
-
-(* Destructs a variable *)
-let destVar c = match kind_of_term c with
- | Var id -> id
- | _ -> raise DestKO
-
-(* Destructs a type *)
-let isSort c = match kind_of_term c with
- | Sort _ -> true
- | _ -> false
-
-let destSort c = match kind_of_term c with
- | Sort s -> s
- | _ -> raise DestKO
-
-let rec isprop c = match kind_of_term c with
- | Sort (Prop _) -> true
- | Cast (c,_,_) -> isprop c
- | _ -> false
-
-let rec is_Prop c = match kind_of_term c with
- | Sort (Prop Null) -> true
- | Cast (c,_,_) -> is_Prop c
- | _ -> false
-
-let rec is_Set c = match kind_of_term c with
- | Sort (Prop Pos) -> true
- | Cast (c,_,_) -> is_Set c
- | _ -> false
-
-let rec is_Type c = match kind_of_term c with
- | Sort (Type _) -> true
- | Cast (c,_,_) -> is_Type c
- | _ -> false
-
-let is_small = Sorts.is_small
-
-let iskind c = isprop c || is_Type c
-
-(* Tests if an evar *)
-let isEvar c = match kind_of_term c with Evar _ -> true | _ -> false
-
-let isEvar_or_Meta c = match kind_of_term c with
- | Evar _ | Meta _ -> true
- | _ -> false
-
-(* Destructs a casted term *)
-let destCast c = match kind_of_term c with
- | Cast (t1,k,t2) -> (t1,k,t2)
- | _ -> raise DestKO
-
-let isCast c = match kind_of_term c with Cast _ -> true | _ -> false
-
-
-(* Tests if a de Bruijn index *)
-let isRel c = match kind_of_term c with Rel _ -> true | _ -> false
-let isRelN n c =
- match kind_of_term c with Rel n' -> Int.equal n n' | _ -> false
-
-(* Tests if a variable *)
-let isVar c = match kind_of_term c with Var _ -> true | _ -> false
-let isVarId id c =
- match kind_of_term c with Var id' -> Id.equal id id' | _ -> false
-
-(* Tests if an inductive *)
-let isInd c = match kind_of_term c with Ind _ -> true | _ -> false
-
-(* Destructs the product (x:t1)t2 *)
-let destProd c = match kind_of_term c with
- | Prod (x,t1,t2) -> (x,t1,t2)
- | _ -> raise DestKO
-
-let isProd c = match kind_of_term c with | Prod _ -> true | _ -> false
-
-(* Destructs the abstraction [x:t1]t2 *)
-let destLambda c = match kind_of_term c with
- | Lambda (x,t1,t2) -> (x,t1,t2)
- | _ -> raise DestKO
-
-let isLambda c = match kind_of_term c with | Lambda _ -> true | _ -> false
-
-(* Destructs the let [x:=b:t1]t2 *)
-let destLetIn c = match kind_of_term c with
- | LetIn (x,b,t1,t2) -> (x,b,t1,t2)
- | _ -> raise DestKO
-
-let isLetIn c = match kind_of_term c with LetIn _ -> true | _ -> false
-
-(* Destructs an application *)
-let destApp c = match kind_of_term c with
- | App (f,a) -> (f, a)
- | _ -> raise DestKO
-
+let destRel = destRel
+let destMeta = destRel
+let isMeta = isMeta
+let destVar = destVar
+let isSort = isSort
+let destSort = destSort
+let isprop = isprop
+let is_Prop = is_Prop
+let is_Set = is_Set
+let is_Type = is_Type
+let is_small = is_small
+let iskind = iskind
+let isEvar = isEvar
+let isEvar_or_Meta = isEvar_or_Meta
+let destCast = destCast
+let isCast = isCast
+let isRel = isRel
+let isRelN = isRelN
+let isVar = isVar
+let isVarId = isVarId
+let isInd = isInd
+let destProd = destProd
+let isProd = isProd
+let destLambda = destLambda
+let isLambda = isLambda
+let destLetIn = destLetIn
+let isLetIn = isLetIn
+let destApp = destApp
let destApplication = destApp
-
-let isApp c = match kind_of_term c with App _ -> true | _ -> false
-
-(* Destructs a constant *)
-let destConst c = match kind_of_term c with
- | Const kn -> kn
- | _ -> raise DestKO
-
-let isConst c = match kind_of_term c with Const _ -> true | _ -> false
-
-(* Destructs an existential variable *)
-let destEvar c = match kind_of_term c with
- | Evar (kn, a as r) -> r
- | _ -> raise DestKO
-
-(* Destructs a (co)inductive type named kn *)
-let destInd c = match kind_of_term c with
- | Ind (kn, a as r) -> r
- | _ -> raise DestKO
-
-(* Destructs a constructor *)
-let destConstruct c = match kind_of_term c with
- | Construct (kn, a as r) -> r
- | _ -> raise DestKO
-
-let isConstruct c = match kind_of_term c with Construct _ -> true | _ -> false
-
-(* Destructs a term <p>Case c of lc1 | lc2 .. | lcn end *)
-let destCase c = match kind_of_term c with
- | Case (ci,p,c,v) -> (ci,p,c,v)
- | _ -> raise DestKO
-
-let isCase c = match kind_of_term c with Case _ -> true | _ -> false
-
-let isProj c = match kind_of_term c with Proj _ -> true | _ -> false
-
-let destProj c = match kind_of_term c with
- | Proj (p, c) -> (p, c)
- | _ -> raise DestKO
-
-let destFix c = match kind_of_term c with
- | Fix fix -> fix
- | _ -> raise DestKO
-
-let isFix c = match kind_of_term c with Fix _ -> true | _ -> false
-
-let destCoFix c = match kind_of_term c with
- | CoFix cofix -> cofix
- | _ -> raise DestKO
-
-let isCoFix c = match kind_of_term c with CoFix _ -> true | _ -> false
+let isApp = isApp
+let destConst = destConst
+let isConst = isConst
+let destEvar = destEvar
+let destInd = destInd
+let destConstruct = destConstruct
+let isConstruct = isConstruct
+let destCase = destCase
+let isCase = isCase
+let isProj = isProj
+let destProj = destProj
+let destFix = destFix
+let isFix = isFix
+let destCoFix = destCoFix
+let isCoFix = isCoFix
(******************************************************************)
(* Flattening and unflattening of embedded applications and casts *)
diff --git a/kernel/term.mli b/kernel/term.mli
index 33c6b0b08d..4efb582d06 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -16,90 +16,133 @@ open Constr
*)
+exception DestKO
+[@@ocaml.deprecated "Alias for [Constr.DestKO]"]
+
(** {5 Simple term case analysis. } *)
val isRel : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isRel]"]
val isRelN : int -> constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isRelN]"]
val isVar : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isVar]"]
val isVarId : Id.t -> constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isVarId]"]
val isInd : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isInd]"]
val isEvar : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isEvar]"]
val isMeta : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isMeta]"]
val isEvar_or_Meta : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isEvar_or_Meta]"]
val isSort : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isSort]"]
val isCast : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCast]"]
val isApp : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isApp]"]
val isLambda : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isLambda]"]
val isLetIn : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isletIn]"]
val isProd : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isProp]"]
val isConst : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isConst]"]
val isConstruct : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isConstruct]"]
val isFix : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isFix]"]
val isCoFix : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCoFix]"]
val isCase : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCase]"]
val isProj : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isProj]"]
val is_Prop : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Prop]"]
val is_Set : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Set]"]
val isprop : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isprop]"]
val is_Type : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Type]"]
val iskind : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_kind]"]
val is_small : Sorts.t -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_small]"]
(** {5 Term destructors } *)
(** Destructor operations are partial functions and
@raise DestKO if the term has not the expected form. *)
-exception DestKO
-
(** Destructs a de Bruijn index *)
val destRel : constr -> int
+[@@ocaml.deprecated "Alias for [Constr.destRel]"]
(** Destructs an existential variable *)
val destMeta : constr -> metavariable
+[@@ocaml.deprecated "Alias for [Constr.destMeta]"]
(** Destructs a variable *)
val destVar : constr -> Id.t
+[@@ocaml.deprecated "Alias for [Constr.destVar]"]
(** Destructs a sort. [is_Prop] recognizes the sort {% \textsf{%}Prop{% }%}, whether
[isprop] recognizes both {% \textsf{%}Prop{% }%} and {% \textsf{%}Set{% }%}. *)
val destSort : constr -> Sorts.t
+[@@ocaml.deprecated "Alias for [Constr.destSort]"]
(** Destructs a casted term *)
val destCast : constr -> constr * cast_kind * constr
+[@@ocaml.deprecated "Alias for [Constr.destCast]"]
(** Destructs the product {% $ %}(x:t_1)t_2{% $ %} *)
val destProd : types -> Name.t * types * types
+[@@ocaml.deprecated "Alias for [Constr.destProd]"]
(** Destructs the abstraction {% $ %}[x:t_1]t_2{% $ %} *)
val destLambda : constr -> Name.t * types * constr
+[@@ocaml.deprecated "Alias for [Constr.destLambda]"]
(** Destructs the let {% $ %}[x:=b:t_1]t_2{% $ %} *)
val destLetIn : constr -> Name.t * constr * types * constr
+[@@ocaml.deprecated "Alias for [Constr.destLetIn]"]
(** Destructs an application *)
val destApp : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destApp]"]
(** Obsolete synonym of destApp *)
val destApplication : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destApplication]"]
(** Decompose any term as an applicative term; the list of args can be empty *)
val decompose_app : constr -> constr * constr list
+[@@ocaml.deprecated "Alias for [Constr.decompose_app]"]
(** Same as [decompose_app], but returns an array. *)
val decompose_appvect : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.decompose_appvect]"]
(** Destructs a constant *)
val destConst : constr -> Constant.t puniverses
+[@@ocaml.deprecated "Alias for [Constr.destConst]"]
(** Destructs an existential variable *)
val destEvar : constr -> existential
+[@@ocaml.deprecated "Alias for [Constr.destEvar]"]
(** Destructs a (co)inductive type *)
val destInd : constr -> inductive puniverses
+[@@ocaml.deprecated "Alias for [Constr.destInd]"]
(** Destructs a constructor *)
val destConstruct : constr -> constructor puniverses
+[@@ocaml.deprecated "Alias for [Constr.destConstruct]"]
(** Destructs a [match c as x in I args return P with ... |
Ci(...yij...) => ti | ... end] (or [let (..y1i..) := c as x in I args
@@ -107,9 +150,11 @@ return P in t1], or [if c then t1 else t2])
@return [(info,c,fun args x => P,[|...|fun yij => ti| ...|])]
where [info] is pretty-printing information *)
val destCase : constr -> case_info * constr * constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destCase]"]
(** Destructs a projection *)
val destProj : constr -> projection * constr
+[@@ocaml.deprecated "Alias for [Constr.destProj]"]
(** Destructs the {% $ %}i{% $ %}th function of the block
[Fixpoint f{_ 1} ctx{_ 1} = b{_ 1}
@@ -119,8 +164,10 @@ val destProj : constr -> projection * constr
where the length of the {% $ %}j{% $ %}th context is {% $ %}ij{% $ %}.
*)
val destFix : constr -> fixpoint
+[@@ocaml.deprecated "Alias for [Constr.destFix]"]
val destCoFix : constr -> cofixpoint
+[@@ocaml.deprecated "Alias for [Constr.destCoFix]"]
(** {5 Derived constructors} *)
@@ -415,8 +462,11 @@ val map_constr_with_binders :
[@@ocaml.deprecated "Alias for [Constr.map_with_binders]"]
val map_puniverses : ('a -> 'b) -> 'a puniverses -> 'b puniverses
+[@@ocaml.deprecated "Alias for [Constr.map_puniverses]"]
val univ_of_sort : Sorts.t -> Univ.Universe.t
+[@@ocaml.deprecated "Alias for [Sorts.univ_of_sort]"]
val sort_of_univ : Univ.Universe.t -> Sorts.t
+[@@ocaml.deprecated "Alias for [Sorts.sort_of_univ]"]
val iter_constr : (constr -> unit) -> constr -> unit
[@@ocaml.deprecated "Alias for [Constr.iter]"]
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-08 06:07:20 +0000