try
Cic.CicHash.find localization_tbl t
with Not_found ->
- prerr_endline ("!!! NOT LOCALIZED: " ^ CicPp.ppterm t);
+ HLog.debug ("!!! NOT LOCALIZED: " ^ CicPp.ppterm t);
raise exn'
in
raise (HExtlib.Localized (loc,exn'))
enrich localization_tbl he ~f:(fun _-> msg) exn
;;
-let mk_prod_of_metas metasenv context' subst args =
+let mk_prod_of_metas metasenv context subst args =
let rec mk_prod metasenv context' = function
| [] ->
let (metasenv, idx) =
(* then I generate a name --- using the hint name_hint *)
(* --- that is fresh in context'. *)
let name_hint =
- (* Cic.Name "pippo" *)
FreshNamesGenerator.mk_fresh_name ~subst metasenv
- (* (CicMetaSubst.apply_subst_metasenv subst metasenv) *)
- (CicMetaSubst.apply_subst_context subst context')
+ (CicMetaSubst.apply_subst_context subst context)
Cic.Anonymous
~typ:(CicMetaSubst.apply_subst subst argty)
in
- (* [] and (Cic.Sort Cic.prop) are dummy: they will not be used *)
FreshNamesGenerator.mk_fresh_name ~subst
[] context' name_hint ~typ:(Cic.Sort Cic.Prop)
in
in
metasenv,Cic.Prod (name,meta,target)
in
- mk_prod metasenv context' args
+ mk_prod metasenv context args
;;
let rec type_of_constant uri ugraph =
exn ->
enrich localization_tbl term' exn
~f:(function _ ->
- lazy ("(10)The term " ^
+ lazy ("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 ("(11)The term " ^
+ lazy ("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 ("(12)The term " ^
+ lazy ("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 ("(13)The term " ^
+ lazy ("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 ("(14)The term " ^
+ lazy ("The term " ^
CicMetaSubst.ppterm_in_context ~metasenv subst bo
context' ^ " has type " ^
CicMetaSubst.ppterm_in_context ~metasenv subst ty_of_bo
(fun (metasenv,last,coerc) ->
let pp t =
CicMetaSubst.ppterm_in_context ~metasenv subst t context in
- let subst,metasenv,ugraph =
- fo_unif_subst subst context metasenv last he ugraph in
- debug_print (lazy ("New head: "^ pp coerc));
try
+ let subst,metasenv,ugraph =
+ fo_unif_subst subst context metasenv last he ugraph in
+ debug_print (lazy ("New head: "^ pp coerc));
let tty,ugraph =
- CicTypeChecker.type_of_aux' ~subst metasenv context coerc ugraph in
- debug_print (lazy (" has type: "^ pp tty));
- Some (coerc,tty,subst,metasenv,ugraph)
+ CicTypeChecker.type_of_aux' ~subst metasenv context coerc
+ ugraph
+ in
+ debug_print (lazy (" has type: "^ pp tty));
+ Some (coerc,tty,subst,metasenv,ugraph)
with
| Uncertain _ | RefineFailure _
| HExtlib.Localized (_,Uncertain _)
fo_unif_subst subst context metasenv infty expty ugraph
in
(t, expty), subst, metasenv, ugraph
- with Uncertain _ | RefineFailure _ as exn ->
- if not allow_coercions || not !insert_coercions then
- enrich localization_tbl t exn
- else
+ with (Uncertain _ | RefineFailure _ as exn)
+ when allow_coercions && !insert_coercions ->
let whd = CicReduction.whd ~delta:false in
let clean t s c = whd c (CicMetaSubst.apply_subst s t) in
let infty = clean infty subst context in
let ugraph = CicUniv.empty_ugraph in
match obj with
Cic.Constant (name,Some bo,ty,args,attrs) ->
+ (* CSC: ugly code. Here I need to retrieve in advance the loc of bo
+ since type_of_aux' destroys localization information (which are
+ preserved by type_of_aux *)
+ let loc exn' =
+ try
+ Cic.CicHash.find localization_tbl bo
+ with Not_found ->
+ HLog.debug ("!!! NOT LOCALIZED: " ^ CicPp.ppterm bo);
+ raise exn' in
let bo',boty,metasenv,ugraph =
type_of_aux' ~localization_tbl metasenv [] bo ugraph in
let ty',_,metasenv,ugraph =
type_of_aux' ~localization_tbl metasenv [] ty ugraph in
- let subst,metasenv,ugraph = fo_unif_subst [] [] metasenv boty ty' ugraph in
+ let subst,metasenv,ugraph =
+ try
+ fo_unif_subst [] [] metasenv boty ty' ugraph
+ with
+ RefineFailure _
+ | Uncertain _ as exn ->
+ let msg =
+ lazy ("The term " ^
+ CicMetaSubst.ppterm_in_context ~metasenv [] bo' [] ^
+ " has type " ^
+ CicMetaSubst.ppterm_in_context ~metasenv [] boty [] ^
+ " but is here used with type " ^
+ CicMetaSubst.ppterm_in_context ~metasenv [] ty' [])
+ in
+ let exn' =
+ match exn with
+ RefineFailure _ -> RefineFailure msg
+ | Uncertain _ -> Uncertain msg
+ | _ -> assert false
+ in
+ raise (HExtlib.Localized (loc exn',exn'))
+ in
let bo' = CicMetaSubst.apply_subst subst bo' in
let ty' = CicMetaSubst.apply_subst subst ty' in
let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in