added ~delta parameter to saturate_term and used it when saturating a coercion.

[helm.git] / components / cic_unification / coercGraph.ml

diff --git a/components/cic_unification/coercGraph.ml b/components/cic_unification/coercGraph.ml
index cb33d9e324f0b41851668c37c1f237770b33342a..f12ea14b108e447951fe3691556d9ed760b88c8d 100644 (file)
--- a/components/cic_unification/coercGraph.ml
+++ b/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
       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
@@ -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
 ;;