diff options
| author | Emilio Jesus Gallego Arias | 2020-03-15 17:08:16 -0400 |
|---|---|---|
| committer | Emilio Jesus Gallego Arias | 2020-03-30 19:05:37 -0400 |
| commit | f836b601e3cb81dd24d25ccd910b2506aac998d9 (patch) | |
| tree | 2be52d61cf4ad8b00a9c9b487b340808a3c5ad11 | |
| parent | fa6836e85808c6d97620104b2f33dff49eb2aa74 (diff) | |
[program] Use common type for fixpoint declarations.
| -rw-r--r-- | vernac/comProgramFixpoint.ml | 6 | ||||
| -rw-r--r-- | vernac/obligations.ml | 8 | ||||
| -rw-r--r-- | vernac/obligations.mli | 7 |
3 files changed, 8 insertions, 13 deletions
diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml index f20b294499..56780d00a6 100644 --- a/vernac/comProgramFixpoint.ml +++ b/vernac/comProgramFixpoint.ml @@ -281,15 +281,15 @@ let do_program_recursive ~scope ~poly fixkind fixl = let evd = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals ~fail:true env evd in (* Solve remaining evars *) let evd = nf_evar_map_undefined evd in - let collect_evars id def typ imps = + let collect_evars name def typ impargs = (* Generalize by the recursive prototypes *) let def = nf_evar evd (Termops.it_mkNamedLambda_or_LetIn def rec_sign) in let typ = nf_evar evd (Termops.it_mkNamedProd_or_LetIn typ rec_sign) in let evm = collect_evars_of_term evd def typ in let evars, _, def, typ = - RetrieveObl.retrieve_obligations env id evm + RetrieveObl.retrieve_obligations env name evm (List.length rec_sign) def typ in - (id, def, typ, imps, evars) + ({ DeclareDef.Recthm.name; typ; impargs; args = [] }, def, evars) in let (fixnames,fixrs,fixdefs,fixtypes) = fix in let fiximps = List.map pi2 info in diff --git a/vernac/obligations.ml b/vernac/obligations.ml index 0ffcea3867..435085793c 100644 --- a/vernac/obligations.ml +++ b/vernac/obligations.ml @@ -330,12 +330,12 @@ let add_definition ~name ?term t ~uctx ?(udecl=UState.default_univ_decl) let add_mutual_definitions l ~uctx ?(udecl=UState.default_univ_decl) ?tactic ~poly ?(scope=DeclareDef.Global Declare.ImportDefaultBehavior) ?(kind=Decls.Definition) ?(reduce=reduce) ?hook ?(opaque = false) notations fixkind = - let deps = List.map (fun (n, b, t, imps, obls) -> n) l in + let deps = List.map (fun ({ DeclareDef.Recthm.name; _ }, _, _) -> name) l in List.iter - (fun (n, b, t, impargs, obls) -> - let prg = ProgramDecl.make ~opaque n ~udecl (Some b) t ~uctx deps (Some fixkind) + (fun ({ DeclareDef.Recthm.name; typ; impargs; _ }, b, obls) -> + let prg = ProgramDecl.make ~opaque name ~udecl (Some b) typ ~uctx deps (Some fixkind) notations obls ~impargs ~poly ~scope ~kind reduce ?hook - in progmap_add n (CEphemeron.create prg)) l; + in progmap_add name (CEphemeron.create prg)) l; let _defined = List.fold_left (fun finished x -> if finished then finished diff --git a/vernac/obligations.mli b/vernac/obligations.mli index cb54dfdeb2..f42d199e18 100644 --- a/vernac/obligations.mli +++ b/vernac/obligations.mli @@ -91,12 +91,7 @@ val add_definition : (** Start a [Program Fixpoint] declaration, similar to the above, except it takes a list now. *) val add_mutual_definitions : - ( Names.Id.t - * constr - * types - * Impargs.manual_implicits - * RetrieveObl.obligation_info ) - list + (DeclareDef.Recthm.t * Constr.t * RetrieveObl.obligation_info) list -> uctx:UState.t -> ?udecl:UState.universe_decl (** Universe binders and constraints *) -> ?tactic:unit Proofview.tactic |