| _ -> assert false
;;
+let unvariant newt =
+ match newt with
+ | Cic.Appl (hd::args) ->
+ let uri = CicUtil.uri_of_term hd in
+ (match
+ CicEnvironment.get_obj CicUniv.oblivion_ugraph uri
+ with
+ | Cic.Constant (_,Some t,_,[],attrs),_
+ when List.exists ((=) (`Flavour `Variant)) attrs ->
+ Cic.Appl (t::args)
+ | _ -> newt)
+ | _ -> newt
+;;
+
let is_a_double_coercion t =
let rec subst_nth n x l =
match n,l with
exn ->
enrich localization_tbl s' exn
~f:(function _ ->
- lazy ("The term " ^
+ lazy ("(2) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv:metasenv' subst' s'
context ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv:metasenv' subst' ty'
exn ->
enrich localization_tbl term' exn
~f:(function _ ->
- lazy ("The term " ^
+ lazy ("(3) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv subst term'
context ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv subst actual_type
exn ->
enrich localization_tbl constructor'
~f:(fun _ ->
- lazy ("The term " ^
+ lazy ("(4) The term " ^
CicMetaSubst.ppterm_in_context metasenv subst p'
context ^ " has type " ^
CicMetaSubst.ppterm_in_context metasenv subst actual_type
exn ->
enrich localization_tbl p exn
~f:(function _ ->
- lazy ("The term " ^
+ lazy ("(5) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv subst p
context ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv subst instance'
exn ->
enrich localization_tbl bo exn
~f:(function _ ->
- lazy ("The term " ^
+ lazy ("(7) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv subst bo
context' ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv subst ty_of_bo
exn ->
enrich localization_tbl bo exn
~f:(function _ ->
- lazy ("The term " ^
+ lazy ("(8) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv subst bo
context' ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv subst ty_of_bo
let selected =
HExtlib.list_findopt
(fun (metasenv,last,c) _ ->
- match c with
- | c when not (CoercGraph.is_composite c) ->
- debug_print (lazy ("\nNot a composite.."^CicPp.ppterm c));
- None
- | c ->
let subst,metasenv,ugraph =
fo_unif_subst subst context metasenv last head ugraph in
debug_print (lazy ("\nprovo" ^ CicPp.ppterm c));
ugraph
in
debug_print (lazy (" has type: "^ pp tty));
- Some (coerc,tty,subst,metasenv,ugraph)
+
+ Some (unvariant coerc,tty,subst,metasenv,ugraph)
with
| Uncertain _ | RefineFailure _
| HExtlib.Localized (_,Uncertain _)
if b then
Some ((t,infty), subst, metasenv, ugraph)
else
+ let newt = unvariant newt in
Some ((newt,newty), subst, metasenv, ugraph)
with
| Uncertain _ -> uncertain := true; None
coerce_to_something_aux t infty expty subst metasenv context ugraph
with Uncertain _ | RefineFailure _ as exn ->
let f _ =
- lazy ("The term " ^
+ lazy ("(9) The term " ^
CicMetaSubst.ppterm_in_context metasenv subst t context ^
" has type " ^ CicMetaSubst.ppterm_in_context metasenv subst
infty context ^ " but is here used with type " ^
RefineFailure _
| Uncertain _ as exn ->
let msg =
- lazy ("The term " ^
+ lazy ("(1) The term " ^
CicMetaSubst.ppterm_in_context ~metasenv [] bo' [] ^
" has type " ^
CicMetaSubst.ppterm_in_context ~metasenv [] boty [] ^