X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcicRefine.ml;h=95651c49fe96ff9ebddec5eed4a8463422b5d67e;hb=b00485292ea4aa35013415903c1a87a952eb21ad;hp=d10e177d02d61b3aa783353a5582fa134f06dad4;hpb=91f15c0bab1f2e11ef2bf77b5091c52daf64669b;p=helm.git diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml index d10e177d0..95651c49f 100644 --- a/helm/software/components/cic_unification/cicRefine.ml +++ b/helm/software/components/cic_unification/cicRefine.ml @@ -136,9 +136,9 @@ let is_a_double_coercion t = let imp = Cic.Implicit None in let dummyres = false,imp, imp,imp,imp in match t with - | Cic.Appl (c1::tl) when CoercGraph.is_a_coercion c1 -> + | Cic.Appl (c1::tl) when CoercDb.is_a_coercion' c1 -> (match last_of tl with - | sib1,Cic.Appl (c2::tl2) when CoercGraph.is_a_coercion c2 -> + | sib1,Cic.Appl (c2::tl2) when CoercDb.is_a_coercion' c2 -> let sib2,head = last_of tl2 in true, c1, c2, head,Cic.Appl (c1::sib1@[Cic.Appl (c2::sib2@[imp])]) @@ -324,18 +324,14 @@ and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t let module C = Cic in let module S = CicSubstitution in let module U = UriManager in - let try_coercion t subst metasenv context ugraph coercion_tgt c = - let coerced = - match c with - C.Appl l2 -> C.Appl (l2@[t]) - | _ -> C.Appl [c;t] + let try_coercion t subst context ugraph coercion_tgt (metasenv,last,coerced) = + let subst,metasenv,ugraph = + fo_unif_subst subst context metasenv last t ugraph in try - let newt,_,subst,metasenv,ugraph = - type_of_aux subst metasenv context coerced ugraph - in let newt, tty, subst, metasenv, ugraph = - avoid_double_coercion context subst metasenv ugraph newt coercion_tgt + avoid_double_coercion context subst metasenv ugraph coerced + coercion_tgt in Some (newt, tty, subst, metasenv, ugraph) with @@ -452,7 +448,7 @@ and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t | term -> let coercion_tgt = carr (Cic.Sort tgt_sort) subst context in let boh = - CoercGraph.look_for_coercion coercion_src coercion_tgt + CoercGraph.look_for_coercion metasenv subst context coercion_src coercion_tgt in (match boh with | CoercGraph.NoCoercion @@ -475,8 +471,7 @@ and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t | CoercGraph.SomeCoercion candidates -> let selected = HExtlib.list_findopt - (try_coercion - t subst metasenv context ugraph coercion_tgt) + (try_coercion t subst context ugraph coercion_tgt) candidates in match selected with @@ -526,7 +521,7 @@ and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t | coercion_src -> let coercion_tgt = Cic.Sort (Cic.Type (CicUniv.fresh())) in let boh = - CoercGraph.look_for_coercion coercion_src coercion_tgt + CoercGraph.look_for_coercion metasenv subst context coercion_src coercion_tgt in match boh with | CoercGraph.NoCoercion @@ -549,9 +544,8 @@ and type_of_aux' ?(localization_tbl = Cic.CicHash.create 1) metasenv context t | CoercGraph.SomeCoercion candidates -> let selected = HExtlib.list_findopt - (try_coercion - s' subst' metasenv' context ugraph1 coercion_tgt) - candidates + (try_coercion s' subst' context ugraph1 coercion_tgt) + candidates in match selected with | Some x -> x @@ -1204,29 +1198,27 @@ prerr_endline ("poco geniale: nel caso di IRL basterebbe sapere che questo e' il if b then let source_carr = CoercGraph.source_of c2 in let tgt_carr = CicMetaSubst.apply_subst subst ty in - (match CoercGraph.look_for_coercion source_carr tgt_carr + (match CoercGraph.look_for_coercion metasenv subst context source_carr tgt_carr with | CoercGraph.SomeCoercion candidates -> - let selected = + let selected = HExtlib.list_findopt - (function + (function (metasenv,last,c) -> + match c with | c when not (CoercGraph.is_composite c) -> debug_print (lazy ("\nNot a composite.."^CicPp.ppterm c)); None | c -> - let newt = - match c with - | Cic.Appl l -> Cic.Appl (l @ [head]) - | _ -> Cic.Appl [c;head] - in - debug_print (lazy ("\nprovo" ^ CicPp.ppterm newt)); + let subst,metasenv,ugraph = + fo_unif_subst subst context metasenv last head ugraph in + debug_print (lazy ("\nprovo" ^ CicPp.ppterm c)); (try debug_print (lazy ("packing: " ^ - CicPp.ppterm t ^ " ==> " ^ CicPp.ppterm newt)); + CicPp.ppterm t ^ " ==> " ^ CicPp.ppterm c)); let newt,_,subst,metasenv,ugraph = - type_of_aux subst metasenv context newt ugraph in + type_of_aux subst metasenv context c ugraph in debug_print (lazy "tipa..."); let subst, metasenv, ugraph = (* COME MAI C'ERA UN IF su !pack_coercions ??? *) @@ -1340,27 +1332,33 @@ prerr_endline ("poco geniale: nel caso di IRL basterebbe sapere che questo e' il he in let x,xty,subst,metasenv,ugraph = - type_of_aux subst metasenv context x ugraph + (*CSC: here unsharing is necessary to avoid an unwanted + relocalization. However, this also shows a great source of + inefficiency: "x" is refined twice (once now and once in the + subsequent eat_prods_and_args). Morevoer, how is divergence avoided? + *) + type_of_aux subst metasenv context (Unshare.unshare x) ugraph in let carr_src = CoercDb.coerc_carr_of_term (CicMetaSubst.apply_subst subst xty) in let carr_tgt = CoercDb.Fun 0 in - match CoercGraph.look_for_coercion' carr_src carr_tgt with + match CoercGraph.look_for_coercion' metasenv subst context carr_src carr_tgt with | CoercGraph.NoCoercion | CoercGraph.NotMetaClosed | CoercGraph.NotHandled _ -> raise exn | CoercGraph.SomeCoercion candidates -> match HExtlib.list_findopt - (fun coerc -> - let t = Cic.Appl [coerc;x] in - debug_print (lazy ("Tentative " ^ CicMetaSubst.ppterm ~metasenv subst t)); + (fun (metasenv,last,coerc) -> + let subst,metasenv,ugraph = + fo_unif_subst subst context metasenv last x ugraph in + debug_print (lazy ("Tentative " ^ CicMetaSubst.ppterm ~metasenv subst coerc)); try (* we want this to be available in the error handler fo the * following (so it has its own try. *) let t,tty,subst,metasenv,ugraph = - type_of_aux subst metasenv context t ugraph + type_of_aux subst metasenv context coerc ugraph in try let metasenv, hetype' = @@ -1386,8 +1384,12 @@ prerr_endline ("poco geniale: nel caso di IRL basterebbe sapere che questo e' il in Some (subst,metasenv,ugraph,hetype',he,args_bo_and_ty) with Uncertain _ | RefineFailure _ -> None - with Uncertain _ | RefineFailure _ -> None - | exn -> assert false) (* ritornare None, e' un localized *) + with + Uncertain _ + | RefineFailure _ + | HExtlib.Localized (_,Uncertain _) + | HExtlib.Localized (_,RefineFailure _) -> None + | exn -> assert false) (* ritornare None, e' un localized *) candidates with | Some(subst,metasenv,ugraph,hetype',he,args_bo_and_ty)-> @@ -1425,7 +1427,7 @@ prerr_endline ("poco geniale: nel caso di IRL basterebbe sapere che questo e' il in let c_hety = carr hety subst context in let c_s = carr s subst context in - CoercGraph.look_for_coercion c_hety c_s, c_s + CoercGraph.look_for_coercion metasenv subst context c_hety c_s, c_s in (match coer with | CoercGraph.NoCoercion @@ -1452,12 +1454,14 @@ prerr_endline ("poco geniale: nel caso di IRL basterebbe sapere che questo e' il | CoercGraph.SomeCoercion candidates -> let selected = HExtlib.list_findopt - (fun c -> + (fun (metasenv,last,c) -> try - let t = Cic.Appl[c;hete] in + let subst,metasenv,ugraph = + fo_unif_subst subst context metasenv last hete + ugraph in let newt,newhety,subst,metasenv,ugraph = type_of_aux subst metasenv context - t ugraph + c ugraph in let newt, newty, subst, metasenv, ugraph = avoid_double_coercion context subst metasenv