aboutsummaryrefslogtreecommitdiff
path: root/interp
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2016-07-13 17:00:25 +0200
committerPierre-Marie Pédrot2016-07-13 17:00:25 +0200
commit9f003b933c2a3504683a84ed817021659e80bc8f (patch)
tree4e9636ca44aed009d2274b03e64313c770a8b026 /interp
parent7217d14466bf900ec0353b6bbcb7e4d4b78ec2bf (diff)
parent45250332a1e65d434432940a468312f2ab18a2e8 (diff)
Merge branch 'v8.6'
Diffstat (limited to 'interp')
-rw-r--r--interp/constrintern.ml37
-rw-r--r--interp/notation_ops.mli6
2 files changed, 27 insertions, 16 deletions
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 1c50253d9c..438aa2f7c6 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -481,9 +481,14 @@ let intern_local_binder_aux ?(global_level=false) intern lvar (env,bl) = functio
let bl' = List.map (fun a -> BDRawDef a) bl' in
env, bl' @ bl
| LocalRawDef((loc,na as locna),def) ->
- let indef = intern env def in
+ let indef = intern env def in
+ let term, ty =
+ match indef with
+ | GCast (loc, b, Misctypes.CastConv t) -> b, t
+ | _ -> indef, GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)
+ in
(push_name_env lvar (impls_term_list indef) env locna,
- (BDRawDef ((loc,(na,Explicit,Some(indef),GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)))))::bl)
+ (BDRawDef ((loc,(na,Explicit,Some(term),ty))))::bl)
| LocalPattern (loc,p,ty) ->
let tyc =
match ty with
@@ -1609,11 +1614,13 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
(merge_impargs l args) loc
| CRecord (loc, fs) ->
- let fields =
- sort_fields ~complete:true loc fs
- (fun _idx -> CHole (loc, Some (Evar_kinds.QuestionMark (Evar_kinds.Define true)), Misctypes.IntroAnonymous, None))
- in
- begin
+ let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
+ let fields =
+ sort_fields ~complete:true loc fs
+ (fun _idx -> CHole (loc, Some (Evar_kinds.QuestionMark st),
+ Misctypes.IntroAnonymous, None))
+ in
+ begin
match fields with
| None -> user_err_loc (loc, "intern", str"No constructor inference.")
| Some (n, constrname, args) ->
@@ -1683,7 +1690,9 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
GIf (loc, c', (na', p'), intern env b1, intern env b2)
| CHole (loc, k, naming, solve) ->
let k = match k with
- | None -> Evar_kinds.QuestionMark (Evar_kinds.Define true)
+ | None ->
+ let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
+ Evar_kinds.QuestionMark st
| Some k -> k
in
let solve = match solve with
@@ -2030,11 +2039,13 @@ let interp_rawcontext_evars env evdref k bl =
let (env, par, _, impls) =
List.fold_left
(fun (env,params,n,impls) (na, k, b, t) ->
+ let t' =
+ if Option.is_empty b then locate_if_hole (loc_of_glob_constr t) na t
+ else t
+ in
+ let t = understand_tcc_evars env evdref ~expected_type:IsType t' in
match b with
None ->
- let t' = locate_if_hole (loc_of_glob_constr t) na t in
- let t =
- understand_tcc_evars env evdref ~expected_type:IsType t' in
let d = LocalAssum (na,t) in
let impls =
if k == Implicit then
@@ -2044,8 +2055,8 @@ let interp_rawcontext_evars env evdref k bl =
in
(push_rel d env, d::params, succ n, impls)
| Some b ->
- let c = understand_judgment_tcc env evdref b in
- let d = LocalDef (na, c.uj_val, c.uj_type) in
+ let c = understand_tcc_evars env evdref ~expected_type:(OfType t) b in
+ let d = LocalDef (na, c, t) in
(push_rel d env, d::params, n, impls))
(env,[],k+1,[]) (List.rev bl)
in (env, par), impls
diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli
index 0f1b1a8756..854e222e30 100644
--- a/interp/notation_ops.mli
+++ b/interp/notation_ops.mli
@@ -23,7 +23,7 @@ val subst_interpretation :
val ldots_var : Id.t
-(** {5 Translation back and forth between [glob_constr] and [notation_constr] *)
+(** {5 Translation back and forth between [glob_constr] and [notation_constr]} *)
(** Translate a [glob_constr] into a notation given the list of variables
bound by the notation; also interpret recursive patterns *)
@@ -40,7 +40,7 @@ val glob_constr_of_notation_constr_with_binders : Loc.t ->
val glob_constr_of_notation_constr : Loc.t -> notation_constr -> glob_constr
-(** {5 Matching a notation pattern against a [glob_constr] *)
+(** {5 Matching a notation pattern against a [glob_constr]} *)
(** [match_notation_constr] matches a [glob_constr] against a notation
interpretation; raise [No_match] if the matching fails *)
@@ -64,5 +64,5 @@ val match_notation_constr_ind_pattern :
((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
(int * cases_pattern list)
-(** {5 Matching a notation pattern against a [glob_constr] *)
+(** {5 Matching a notation pattern against a [glob_constr]} *)