X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flibrary%2FcoercDb.ml;h=1f3874912b93ff231ca48563a1c9ad04d6f9e23c;hb=e6c985d94df70748f132df23489ff3b60fd108a5;hp=ed3d58c724c66cd71d8b3a5bc0b549aa9c75dbba;hpb=6ea07c7b5d378a25eb6c9b3134aec642b86cd79c;p=helm.git

diff --git a/helm/software/components/library/coercDb.ml b/helm/software/components/library/coercDb.ml
index ed3d58c72..1f3874912 100644
--- a/helm/software/components/library/coercDb.ml
+++ b/helm/software/components/library/coercDb.ml
@@ -41,7 +41,7 @@ let coerc_carr_of_term t =
  try
   match t with
    | Cic.Sort s -> Sort s
-   | Cic.Prod _ -> Fun 0
+   | Cic.Prod _ -> assert false
    | Cic.Appl (t::_)
    | t -> Uri (CicUtil.uri_of_term t)
  with Invalid_argument _ ->
@@ -66,9 +66,20 @@ let rec name_of_carr = function
   | Fun i -> "FunClass_" ^ string_of_int i   
 ;;
 
-let eq_carr src tgt =
+let eq_carr ?(exact=false) src tgt =
   match src, tgt with
-  | Uri src, Uri tgt -> UriManager.eq src tgt
+  | Uri src, Uri tgt -> 
+      let coarse_eq = UriManager.eq src tgt in
+      let src_noxpointer = UriManager.strip_xpointer src in
+      if exact && coarse_eq && UriManager.uri_is_ind src_noxpointer then
+        match 
+          fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph src_noxpointer)
+        with
+        | Cic.InductiveDefinition (_,[],m,_) when m = 0 -> true
+        | Cic.Constant _ -> true
+        | _ -> false
+      else
+        coarse_eq
   | Sort (Cic.Type _), Sort (Cic.Type _) -> true
   | Sort src, Sort tgt when src = tgt -> true
   | Term t1, Term t2 ->
@@ -118,12 +129,6 @@ let find_coercion f =
     (HExtlib.filter_map (fun (s,t,l) -> if f (s,t) then Some l else None) !db))
 ;;
 
-let is_a_coercion u = 
-  List.exists 
-    (fun (_,_,xl) -> List.exists (fun (x,_) -> UriManager.eq u x) xl) 
-    !db
-;;
-
 let get_carr uri =
   try
     let src, tgt, _ = 
@@ -135,6 +140,28 @@ let get_carr uri =
   with Not_found -> assert false (* uri must be a coercion *)
 ;;
 
+let is_a_coercion u = 
+  List.exists 
+    (fun (_,_,xl) -> List.exists (fun (x,_) -> UriManager.eq u x) xl) 
+    !db
+;;
+
+let is_a_coercion' t = 
+  try
+    let uri = CicUtil.uri_of_term t in
+     is_a_coercion uri
+  with Invalid_argument _ -> false
+;;
+
+let is_a_coercion_to_funclass t =
+  try
+    let uri = CicUtil.uri_of_term t in
+    match snd (get_carr uri) with
+    | Fun i -> Some i
+    | _ -> None
+  with Invalid_argument _ -> None
+  
+
 let term_of_carr = function
   | Uri u -> CicUtil.term_of_uri u
   | Sort s -> Cic.Sort s