aboutsummaryrefslogtreecommitdiffhomepage
path: root/pretyping
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/termops.ml17
-rw-r--r--pretyping/termops.mli9
2 files changed, 20 insertions, 6 deletions
diff --git a/pretyping/termops.ml b/pretyping/termops.ml
index a77fc5741..aa6cc297b 100644
--- a/pretyping/termops.ml
+++ b/pretyping/termops.ml
@@ -673,10 +673,18 @@ let subst_term_occ (nowhere_except_in,locs as plocs) c t =
if rest <> [] then error_invalid_occurrence rest;
t'
-let subst_term_occ_decl (nowhere_except_in,locs as plocs) c (id,bodyopt,typ as d) =
- match bodyopt with
- | None -> (id,None,subst_term_occ plocs c typ)
- | Some body ->
+type hyp_location_flag = (* To distinguish body and type of local defs *)
+ | InHyp
+ | InHypTypeOnly
+ | InHypValueOnly
+
+let subst_term_occ_decl ((nowhere_except_in,locs as plocs),hloc) c (id,bodyopt,typ as d) =
+ match bodyopt,hloc with
+ | None, InHypValueOnly -> errorlabstrm "" (pr_id id ++ str " has no value")
+ | None, _ -> (id,None,subst_term_occ plocs c typ)
+ | Some body, InHypTypeOnly -> (id,Some body,subst_term_occ plocs c typ)
+ | Some body, InHypValueOnly -> (id,Some (subst_term_occ plocs c body),typ)
+ | Some body, InHyp ->
if locs = [] then
if nowhere_except_in then d
else (id,Some (subst_term c body),subst_term c typ)
@@ -687,7 +695,6 @@ let subst_term_occ_decl (nowhere_except_in,locs as plocs) c (id,bodyopt,typ as d
if rest <> [] then error_invalid_occurrence rest;
(id,Some body',t')
-
(* First character of a constr *)
let lowercase_first_char id =
diff --git a/pretyping/termops.mli b/pretyping/termops.mli
index e9516ec48..92c0a78d4 100644
--- a/pretyping/termops.mli
+++ b/pretyping/termops.mli
@@ -150,8 +150,15 @@ val subst_term_occ : occurrences -> constr -> constr -> constr
(* [subst_term_occ_decl occl c decl] replaces occurrences of [c] at
positions [occl] by [Rel 1] in [decl] *)
+
+type hyp_location_flag = (* To distinguish body and type of local defs *)
+ | InHyp
+ | InHypTypeOnly
+ | InHypValueOnly
+
val subst_term_occ_decl :
- occurrences -> constr -> named_declaration -> named_declaration
+ occurrences * hyp_location_flag -> constr -> named_declaration ->
+ named_declaration
val error_invalid_occurrence : int list -> 'a