X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcoercGraph.ml;h=ac7441a4cdad4ee5f40fda81d3c0cf213cf7fb3e;hb=ed5c4e15429c37bef0f59dfd7160f6883586ed0f;hp=cb33d9e324f0b41851668c37c1f237770b33342a;hpb=4f2e7eacea9e8b3089a575d7bf529fd5e70e8453;p=helm.git

diff --git a/helm/software/components/cic_unification/coercGraph.ml b/helm/software/components/cic_unification/coercGraph.ml
index cb33d9e32..ac7441a4c 100644
--- a/helm/software/components/cic_unification/coercGraph.ml
+++ b/helm/software/components/cic_unification/coercGraph.ml
@@ -41,23 +41,24 @@ let debug = false
 let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
 
 let saturate_coercion ul metasenv subst context =
-  let cl = List.map CicUtil.term_of_uri ul in
+  let cl =
+   List.map (fun u,saturations -> CicUtil.term_of_uri u,saturations) ul in
   let funclass_arityl = 
-    let _,tgtcarl = List.split (List.map CoercDb.get_carr ul) in
+    let _,tgtcarl = List.split (List.map (fun u,_ -> CoercDb.get_carr u) ul) in
     List.map (function CoercDb.Fun i -> i | _ -> 0) tgtcarl
   in
   let freshmeta = CicMkImplicit.new_meta metasenv subst in
    List.map2
-    (fun arity c -> 
+    (fun arity (c,saturations) -> 
       let ty,_ =
        CicTypeChecker.type_of_aux' ~subst metasenv context c
-        CicUniv.empty_ugraph in
+        CicUniv.oblivion_ugraph in
       let _,metasenv,args,lastmeta =
-       TermUtil.saturate_term freshmeta metasenv context ty arity in
+       TermUtil.saturate_term ~delta:false freshmeta metasenv context ty arity in
       let irl =
        CicMkImplicit.identity_relocation_list_for_metavariable context
       in
-       metasenv, Cic.Meta (lastmeta-1,irl),
+       metasenv, Cic.Meta (lastmeta - saturations - 1,irl),
         match args with
            [] -> c
          | _ -> Cic.Appl (c::args)
@@ -128,18 +129,23 @@ let generate_dot_file () =
         Pp.node (CoercDb.name_of_carr carr)
           ~attrs:["href", UriManager.string_of_uri uri] fmt in
   List.iter
-    (fun (src, tgt, cl) ->
+    (fun (src, tgt, ul) ->
       let src_name = CoercDb.name_of_carr src in
       let tgt_name = CoercDb.name_of_carr tgt in
       pp_description src;
       pp_description tgt;
       List.iter
-        (fun c ->
+        (fun (u,saturations) ->
           Pp.edge src_name tgt_name
-            ~attrs:[ "label", UriManager.name_of_uri c;
-              "href", UriManager.string_of_uri c ]
+            ~attrs:[ "label",
+                     (UriManager.name_of_uri u ^
+                      if saturations = 0 then
+                       ""
+                      else
+                       "(" ^ string_of_int saturations ^ ")");
+              "href", UriManager.string_of_uri u ]
             fmt)
-        cl)
+        ul)
     l;
   Pp.trailer fmt;
   Buffer.contents buf
@@ -152,7 +158,7 @@ let is_composite t =
       | Cic.Appl (he::_) -> CicUtil.uri_of_term he
       | _ -> CicUtil.uri_of_term t
     in
-    match CicEnvironment.get_obj CicUniv.empty_ugraph uri with
+    match CicEnvironment.get_obj CicUniv.oblivion_ugraph uri with
     | Cic.Constant (_,_, _, _, attrs),_  ->
         List.exists (function `Class (`Coercion _) -> true | _ -> false) attrs
     | _ -> false
@@ -176,7 +182,7 @@ let coerced_arg l =
         | _ -> 0
       in
       let uri = CicUtil.uri_of_term c in
-      match fst(CicEnvironment.get_obj CicUniv.empty_ugraph uri) with
+      match fst(CicEnvironment.get_obj CicUniv.oblivion_ugraph uri) with
       | Cic.Constant (_, _, ty, _, _) -> count_pi ty
       | _ -> assert false
     in
@@ -186,7 +192,7 @@ let coerced_arg l =
 (************************* meet calculation stuff ********************)
 let eq_uri_opt u1 u2 = 
   match u1,u2 with
-  | Some u1, Some u2 -> UriManager.eq u1 u2
+  | Some (u1,_), Some (u2,_) -> UriManager.eq u1 u2
   | None,Some _ | Some _, None -> false
   | None, None -> true
 ;;