(* Enriching a exception message *)
-let rec handle_exn _r _n _fn_name = function x -> x
+let handle_exn _r _n _fn_name = function x -> x
(*CSC: only for pretty printing
| MLexn s ->
(try Scanf.sscanf s "UNBOUND %d"
(* [decomp_lams_eta env c t] finds the number [n] of products in the type [t],
and decompose the term [c] in [n] lambdas, with eta-expansion if needed. *)
-let rec decomp_lams_eta_n n m status context c t =
+let decomp_lams_eta_n n m status context c t =
let rels = fst (splay_prod_n status context n t) in
let rels',c = decompose_lam c in
let d = n - m in
NReference.reference_of_spec uri (NReference.CoFix i)) in
ti,ci,n,vkn
+(*s Is a [ml_spec] logical ? *)
+let logical_spec = function
+ | Stype (_, [], Some (Tdummy _)) -> true
+ | Sval (_,Tdummy _) -> true
+ | Sind i -> array_for_all (fun ip -> ip.ip_logical) i.ind_packets
+ | _ -> false
+
let extract_fixpoint status uri height fix_or_cofix is_projection ifl =
let status =
if is_projection then
(fun status i _ ->
let _,head = split_all_prods status ~subst:[] [] ti.(i) in
match head with
- NCic.Sort _ ->
- (*let n = type_scheme_nb_args status [] typ in*)
- (*let ids = iterate (fun l -> anonymous_name::l) n [] in*)
- let ids = [] in
+ NCic.Sort s when classify_sort s = InProp -> status,`None
+ | NCic.Sort _ ->
+ let n = type_scheme_nb_args status [] ti.(i) in
+ let ids = iterate (fun l -> anonymous_name::l) n [] in
status,`Type (Dtype (vkn.(i), ids, Tunknown))
| _ ->
if sort_of status [] ti.(i) <> InProp then
(fun status i vkn ->
if sort_of status [] ti.(i) <> InProp then begin
let status,spec = extract_constant_spec status vkn None ti.(i) in
- status, Some spec
+ status, if logical_spec spec then None else Some spec
end
else status,None
) vkn in
| Dind i -> array_for_all (fun ip -> ip.ip_logical) i.ind_packets
| _ -> false
-(*s Is a [ml_spec] logical ? *)
-
-let logical_spec = function
- | Stype (_, [], Some (Tdummy _)) -> true
- | Sval (_,Tdummy _) -> true
- | Sind i -> array_for_all (fun ip -> ip.ip_logical) i.ind_packets
- | _ -> false
-
let extract_impl status (uri,height,metasenv,subst,obj_kind) =
assert (metasenv=[]);
assert (subst=[]);