]> matita.cs.unibo.it Git - helm.git/commitdiff
One more error localized. But the code is really ugly here :-(
authorClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Tue, 4 Dec 2007 15:56:03 +0000 (15:56 +0000)
committerClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Tue, 4 Dec 2007 15:56:03 +0000 (15:56 +0000)
helm/software/components/cic_unification/cicRefine.ml

index 4569601cd082212fd448e90b84490c515b0b9d80..9099c262f69ce8d7ae09175f34dd67daa783b122 100644 (file)
@@ -1829,11 +1829,36 @@ let typecheck metasenv uri obj ~localization_tbl =
  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 =
+      try
+       Cic.CicHash.find localization_tbl bo
+      with Not_found -> assert false 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
+           match exn with
+              RefineFailure _ -> raise (HExtlib.Localized (loc,RefineFailure msg))
+            | Uncertain _ -> raise (HExtlib.Localized (loc,Uncertain msg))
+            | _ -> assert false
+     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