diff options
| author | Pierre-Marie Pédrot | 2019-06-25 17:26:44 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2019-06-25 17:26:44 +0200 |
| commit | 7dfcb0f7c817e66280ab37b6c653b5596a16c249 (patch) | |
| tree | f59cbad4ef2e56070fe32fefcc5f7a3f8c6b7a4a /vernac/comProgramFixpoint.ml | |
| parent | 7024688c4e20fa7b70ac1c550c166d02fce8d15c (diff) | |
| parent | c2abcaefd796b7f430f056884349b9d959525eec (diff) | |
Merge PR #10316: [lemmas] Reify info for implicits, universe decls, and rec theorems.
Reviewed-by: SkySkimmer
Ack-by: ejgallego
Reviewed-by: gares
Reviewed-by: ppedrot
Diffstat (limited to 'vernac/comProgramFixpoint.ml')
| -rw-r--r-- | vernac/comProgramFixpoint.ml | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml index 6c1c23eacb..d804957917 100644 --- a/vernac/comProgramFixpoint.ml +++ b/vernac/comProgramFixpoint.ml @@ -234,8 +234,8 @@ let build_wellfounded (recname,pl,bl,arityc,body) poly r measure notation = Obligations.eterm_obligations env recname sigma 0 def typ in let ctx = Evd.evar_universe_context sigma in - ignore(Obligations.add_definition recname ~term:evars_def ~univdecl:decl - evars_typ ctx evars ~hook) + ignore(Obligations.add_definition ~name:recname ~term:evars_def ~univdecl:decl + ~poly evars_typ ctx evars ~hook) let out_def = function | Some def -> def @@ -246,7 +246,7 @@ let collect_evars_of_term evd c ty = Evar.Set.fold (fun ev acc -> Evd.add acc ev (Evd.find_undefined evd ev)) evars (Evd.from_ctx (Evd.evar_universe_context evd)) -let do_program_recursive local poly fixkind fixl ntns = +let do_program_recursive ~scope ~poly fixkind fixl ntns = let cofix = fixkind = DeclareObl.IsCoFixpoint in let (env, rec_sign, pl, evd), fix, info = interp_recursive ~cofix ~program_mode:true fixl ntns @@ -288,12 +288,12 @@ let do_program_recursive local poly fixkind fixl ntns = end in let ctx = Evd.evar_universe_context evd in let kind = match fixkind with - | DeclareObl.IsFixpoint _ -> (local, poly, Fixpoint) - | DeclareObl.IsCoFixpoint -> (local, poly, CoFixpoint) + | DeclareObl.IsFixpoint _ -> Fixpoint + | DeclareObl.IsCoFixpoint -> CoFixpoint in - Obligations.add_mutual_definitions defs ~kind ~univdecl:pl ctx ntns fixkind + Obligations.add_mutual_definitions defs ~poly ~scope ~kind ~univdecl:pl ctx ntns fixkind -let do_program_fixpoint local poly l = +let do_program_fixpoint ~scope ~poly l = let g = List.map (fun ((_,wf,_,_,_),_) -> wf) l in match g, l with | [Some { CAst.v = CWfRec (n,r) }], [((({CAst.v=id},pl),_,bl,typ,def),ntn)] -> @@ -316,7 +316,7 @@ let do_program_fixpoint local poly l = | _, _ when List.for_all (fun ro -> match ro with None | Some { CAst.v = CStructRec _} -> true | _ -> false) g -> let fixl,ntns = extract_fixpoint_components ~structonly:true l in let fixkind = DeclareObl.IsFixpoint (List.map (fun d -> d.fix_annot) fixl) in - do_program_recursive local poly fixkind fixl ntns + do_program_recursive ~scope ~poly fixkind fixl ntns | _, _ -> user_err ~hdr:"do_program_fixpoint" @@ -334,11 +334,11 @@ let check_safe () = let flags = Environ.typing_flags (Global.env ()) in flags.check_universes && flags.check_guarded -let do_fixpoint local poly l = - do_program_fixpoint local poly l; +let do_fixpoint ~scope ~poly l = + do_program_fixpoint ~scope ~poly l; if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else () -let do_cofixpoint local poly l = +let do_cofixpoint ~scope ~poly l = let fixl,ntns = extract_cofixpoint_components l in - do_program_recursive local poly DeclareObl.IsCoFixpoint fixl ntns; + do_program_recursive ~scope ~poly DeclareObl.IsCoFixpoint fixl ntns; if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else () |
