X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flibrary%2FcoercDb.ml;h=80222ad341f9d0ae8be79861a64735e03c46cbdc;hb=08e9d02504942642a917c0d3e4b4795e65172d89;hp=e0dc18d05f7146e9bf0125265eb9ef4aaa41e660;hpb=5da42f6120f3075c3da8ab3082ead39ea57955fa;p=helm.git

diff --git a/helm/software/components/library/coercDb.ml b/helm/software/components/library/coercDb.ml
index e0dc18d05..80222ad34 100644
--- a/helm/software/components/library/coercDb.ml
+++ b/helm/software/components/library/coercDb.ml
@@ -41,7 +41,10 @@ let coerc_carr_of_term t =
  try
   match t with
    | Cic.Sort s -> Sort s
-   | Cic.Prod _ -> assert false
+   | Cic.Prod _ -> Fun 0 
+     (* BUG: this should be the real arity. The computation
+      requires menv, context etc.., but since carrs are compared discharging Fun
+      arity... it works *)
    | Cic.Appl (t::_)
    | t -> Uri (CicUtil.uri_of_term t)
  with Invalid_argument _ ->
@@ -70,16 +73,12 @@ let eq_carr ?(exact=false) src tgt =
   match src, tgt with
   | 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
+      let t = CicUtil.term_of_uri src in
+      let ty,_ = CicTypeChecker.type_of_aux' [] [] t CicUniv.oblivion_ugraph in
+      (match ty, exact with
+      | Cic.Prod _, true -> false
+      | Cic.Prod _, false -> coarse_eq
+      | _ -> coarse_eq) 
   | Sort (Cic.Type _), Sort (Cic.Type _) -> true
   | Sort src, Sort tgt when src = tgt -> true
   | Term t1, Term t2 ->
@@ -180,7 +179,6 @@ let add_coercion (src,tgt,u,saturations) =
       if List.exists (fun (x,_,_) -> UriManager.eq u x) l then
         let l' = List.map
           (fun (x,n,saturations') ->
-            assert (saturations=saturations');
             if UriManager.eq u x then
              (x,n+1,saturations)
             else
@@ -192,3 +190,7 @@ let add_coercion (src,tgt,u,saturations) =
         db := (src,tgt,(u,1,saturations)::l)::tl @ rest
       
 ;;
+
+type coerc_db = (coerc_carr * coerc_carr * (UriManager.uri * int * int) list) list 
+let dump () = !db 
+let restore coerc_db = db := coerc_db