X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_unification%2FcoercGraph.ml;h=d99fc6f798f67f72ccbee796adc50b8bd0db1474;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=2e69c648657646867879bebbdafd49148ea7212c;hpb=8b55faddb06e3c4b0a13839210bb49170939b33e;p=helm.git diff --git a/helm/ocaml/cic_unification/coercGraph.ml b/helm/ocaml/cic_unification/coercGraph.ml index 2e69c6486..d99fc6f79 100644 --- a/helm/ocaml/cic_unification/coercGraph.ml +++ b/helm/ocaml/cic_unification/coercGraph.ml @@ -43,10 +43,23 @@ let look_for_coercion src tgt = (fun (s,t) -> CoercDb.eq_carr s src && CoercDb.eq_carr t tgt) in match l with - | [] -> debug_print (lazy ":( coercion non trovata"); NoCoercion + | [] -> + debug_print + (lazy + (sprintf ":-( coercion non trovata da %s a %s" + (CoercDb.name_of_carr src) + (CoercDb.name_of_carr tgt))); + NoCoercion + | [u] -> + debug_print (lazy ( + sprintf ":-) TROVATA 1 coercion da %s a %s: %s" + (CoercDb.name_of_carr src) + (CoercDb.name_of_carr tgt) + (UriManager.name_of_uri u))); + SomeCoercion (CicUtil.term_of_uri u) | u::_ -> debug_print (lazy ( - sprintf ":) TROVATE %d coercion(s) da %s a %s, prendo la prima: %s" + sprintf ":-/ TROVATE %d coercion(s) da %s a %s, prendo la prima: %s" (List.length l) (CoercDb.name_of_carr src) (CoercDb.name_of_carr tgt) @@ -67,13 +80,19 @@ let look_for_coercion src tgt = * (source, list of coercions to follow, target) *) let get_closure_coercions src tgt uri coercions = + let eq_carr s t = + try + CoercDb.eq_carr s t + with + | CoercDb.EqCarrNotImplemented _ | CoercDb.EqCarrOnNonMetaClosed -> false + in match src,tgt with | CoercDb.Uri _, CoercDb.Uri _ -> let c_from_tgt = - List.filter (fun (f,_,_) -> CoercDb.eq_carr f tgt) coercions + List.filter (fun (f,_,_) -> eq_carr f tgt) coercions in let c_to_src = - List.filter (fun (_,t,_) -> CoercDb.eq_carr t src) coercions + List.filter (fun (_,t,_) -> eq_carr t src) coercions in (List.map (fun (_,t,u) -> src,[uri; u],t) c_from_tgt) @ (List.map (fun (s,_,u) -> s,[u; uri],tgt) c_to_src) @