+let rec strip_pi = function
+ | Cic.Prod (_, _, tgt) -> strip_pi tgt
+ | t -> t
+
+let rec count_pi = function
+ | Cic.Prod (_, _, tgt) -> count_pi tgt + 1
+ | t -> 0
+
+let rec type_of_p sort dependent leftno indty = function
+ | Cic.Prod (n, src, tgt) when leftno = 0 ->
+ let n =
+ if dependent then
+ match n with
+ Cic.Name _ -> n
+ | Cic.Anonymous -> fresh_binder ()
+ else
+ n
+ in
+ Cic.Prod (n, src, type_of_p sort dependent leftno indty tgt)
+ | Cic.Prod (_, _, tgt) -> type_of_p sort dependent (leftno - 1) indty tgt
+ | t ->
+ if dependent then
+ Cic.Prod (Cic.Anonymous, indty, Cic.Sort sort)
+ else
+ Cic.Sort sort
+
+let rec add_right_pi dependent strip liftno liftfrom rightno indty = function
+ | Cic.Prod (_, src, tgt) when strip = 0 ->
+ Cic.Prod (fresh_binder (),
+ CicSubstitution.lift_from liftfrom liftno src,
+ add_right_pi dependent strip liftno (liftfrom + 1) rightno indty tgt)
+ | Cic.Prod (_, _, tgt) ->
+ add_right_pi dependent (strip - 1) liftno liftfrom rightno indty tgt
+ | t ->
+ if dependent then
+ Cic.Prod (fresh_binder (),
+ CicSubstitution.lift_from (rightno + 1) liftno indty,
+ Cic.Appl (Cic.Rel (1 + liftno + rightno) :: mk_rels 0 (rightno + 1)))
+ else
+ Cic.Prod (Cic.Anonymous,
+ CicSubstitution.lift_from (rightno + 1) liftno indty,
+ if rightno = 0 then
+ Cic.Rel (1 + liftno + rightno)
+ else
+ Cic.Appl (Cic.Rel (1 + liftno + rightno) :: mk_rels 1 rightno))
+
+let rec add_right_lambda dependent strip liftno liftfrom rightno indty case =
+function
+ | Cic.Prod (_, src, tgt) when strip = 0 ->
+ Cic.Lambda (fresh_binder (),
+ CicSubstitution.lift_from liftfrom liftno src,
+ add_right_lambda dependent strip liftno (liftfrom + 1) rightno indty
+ case tgt)
+ | Cic.Prod (_, _, tgt) ->
+ add_right_lambda true (strip - 1) liftno liftfrom rightno indty
+ case tgt
+ | t ->
+ Cic.Lambda (fresh_binder (),
+ CicSubstitution.lift_from (rightno + 1) liftno indty, case)
+
+let rec branch (uri, typeno) insource paramsno t fix head args =
+ match t with
+ | Cic.MutInd (uri', typeno', []) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ if insource then
+ (match args with
+ | [arg] -> Cic.Appl (fix :: args)
+ | _ -> Cic.Appl (head :: [Cic.Appl args]))
+ else
+ (match args with
+ | [] -> head
+ | _ -> Cic.Appl (head :: args))
+ | Cic.Appl (Cic.MutInd (uri', typeno', []) :: tl) when
+ UriManager.eq uri uri' && typeno = typeno' ->
+ if insource then
+ let (lparams, rparams) = split tl paramsno in
+ match args with
+ | [arg] -> Cic.Appl (fix :: rparams @ args)
+ | _ -> Cic.Appl (fix :: rparams @ [Cic.Appl args])
+ else
+ (match args with
+ | [] -> head
+ | _ -> Cic.Appl (head :: args))
+ | Cic.Prod (binder, src, tgt) ->
+ if recursive uri typeno src then
+ let args = List.map (CicSubstitution.lift 1) args in
+ let phi =
+ let fix = CicSubstitution.lift 1 fix in
+ let src = CicSubstitution.lift 1 src in
+ branch (uri, typeno) true paramsno src fix head [Cic.Rel 1]
+ in
+ Cic.Lambda (fresh_binder (), src,
+ branch (uri, typeno) insource paramsno tgt
+ (CicSubstitution.lift 1 fix) (CicSubstitution.lift 1 head)
+ (args @ [Cic.Rel 1; phi]))
+ else (* non recursive *)
+ let args = List.map (CicSubstitution.lift 1) args in
+ Cic.Lambda (fresh_binder (), src,
+ branch (uri, typeno) insource paramsno tgt
+ (CicSubstitution.lift 1 fix) (CicSubstitution.lift 1 head)
+ (args @ [Cic.Rel 1]))
+ | _ -> assert false
+
+let branch (uri, typeno) insource liftno paramsno t fix head args =
+ let t = strip_left_params liftno paramsno t in
+ branch (uri, typeno) insource paramsno t fix head args
+
+let elim_of ~sort uri typeno =
+ counter := ~-1;
+ let (obj, univ) = (CicEnvironment.get_obj CicUniv.empty_ugraph uri) in