From f836b601e3cb81dd24d25ccd910b2506aac998d9 Mon Sep 17 00:00:00 2001
From: Emilio Jesus Gallego Arias
Date: Sun, 15 Mar 2020 17:08:16 -0400
Subject: [program] Use common type for fixpoint declarations.

---
 vernac/comProgramFixpoint.ml | 6 +++---
 vernac/obligations.ml        | 8 ++++----
 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
-- 
cgit v1.2.3