X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicCoercion.ml;h=e48e772079b86ef6d0d0eb8fafc9fca6706b3852;hb=67d5f78ad9593d51846bd6a69fca27e9a4ef0e6d;hp=8a6e8a1c818f5f19a99ff816531a19eb9f3561fc;hpb=5d492df3e2715395a554f64dc3f040e13f892974;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicCoercion.ml b/helm/software/components/ng_refiner/nCicCoercion.ml index 8a6e8a1c8..e48e77207 100644 --- a/helm/software/components/ng_refiner/nCicCoercion.ml +++ b/helm/software/components/ng_refiner/nCicCoercion.ml @@ -134,3 +134,34 @@ let look_for_coercion status metasenv subst context infty expty = metasenv, NCicUntrusted.mk_appl t args, ty, List.nth args arg) (CoercionSet.elements candidates) ;; + +(* CSC: very inefficient implementation! + Enrico, can we use a discrimination tree here? *) +let match_coercion status ~metasenv ~subst ~context t = + let db = + DB.fold (fst (status#coerc_db)) (fun _ v l -> (CoercionSet.elements v)@l) [] + in + (HExtlib.list_findopt + (fun (p,arity,cpos) _ -> + try + let t = + match p,t with + NCic.Appl lp, NCic.Appl lt -> + (match fst (HExtlib.split_nth (List.length lp) lt) with + [t] -> t + | l -> NCic.Appl l) + | _,NCic.Appl (he::_) -> he + | _,_ -> t + in + let b = NCicReduction.alpha_eq metasenv subst context p t in + if not b then None else + let ty = NCicTypeChecker.typeof ~metasenv:[] ~subst:[] [] p in + let pis = + let rec aux = function NCic.Prod (_,_,t) -> 1+aux t | _ -> 0 in + aux ty + in + Some (p,pis - arity - cpos - 1,cpos) + with + Failure _ -> None (* raised by split_nth *) + ) db) +;;