Patch to add a debugging string to HExtlib.split_nth reverted

[helm.git] / helm / software / components / cic_unification / cicRefine.ml

diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml
index eb350d2e5165500501cea3efb33154a31fad6f4b..b535b9ebe987677505d7d9b40a2c59731a4c2606 100644 (file)
--- a/helm/software/components/cic_unification/cicRefine.ml
+++ b/helm/software/components/cic_unification/cicRefine.ml
@@ -337,8 +337,8 @@ and check_branch n context metasenv subst left_args_no actualtype term expectedt
              | _ -> raise (AssertFailure (lazy "Wrong number of arguments")))
       | _ -> raise (AssertFailure (lazy "Prod or MutInd expected"))
 
-and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.CicHash.create 1) metasenv context t
-     ugraph
+and type_of_aux' ?(clean_dummy_dependent_types=true) 
+  ?(localization_tbl = Cic.CicHash.create 1) metasenv subst context t ugraph
 =
   let rec type_of_aux subst metasenv context t ugraph =
     let module C = Cic in
@@ -505,7 +505,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
              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'
@@ -631,7 +631,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
              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
@@ -677,7 +677,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                     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
@@ -865,7 +865,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                       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'
@@ -906,7 +906,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                      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
@@ -959,7 +959,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                      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
@@ -1790,7 +1790,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
       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 " ^ 
@@ -1828,7 +1828,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
   (* eat prods ends here! *)
   
   let t',ty,subst',metasenv',ugraph1 =
-   type_of_aux [] metasenv context t ugraph
+   type_of_aux subst metasenv context t ugraph
   in
   let substituted_t = CicMetaSubst.apply_subst subst' t' in
   let substituted_ty = CicMetaSubst.apply_subst subst' ty in
@@ -1872,7 +1872,21 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
    else
     substituted_metasenv
   in
-    (cleaned_t,cleaned_ty,cleaned_metasenv,ugraph1) 
+    (cleaned_t,cleaned_ty,cleaned_metasenv,subst',ugraph1) 
+;;
+
+let type_of metasenv subst context t ug =
+  type_of_aux' metasenv subst context t ug
+;;
+
+let type_of_aux' 
+  ?clean_dummy_dependent_types ?localization_tbl metasenv context t ug
+=
+  let t,ty,m,s,ug = 
+    type_of_aux' ?clean_dummy_dependent_types ?localization_tbl 
+      metasenv [] context t ug
+  in
+  t,ty,m,ug
 ;;
 
 let undebrujin uri typesno tys t =
@@ -1973,7 +1987,7 @@ let typecheck metasenv uri obj ~localization_tbl =
          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 [] ^