X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcoercGraph.ml;h=f12ea14b108e447951fe3691556d9ed760b88c8d;hb=08e9d02504942642a917c0d3e4b4795e65172d89;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..f12ea14b1 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 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 ;;