X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicUnifHint.ml;h=d166b19360fa391fd0a4febc334fe7f28bdaded5;hb=c22f39a5d5afc0ef55beb221e00e2e6703b13d90;hp=9532ba985e67553e771ec495c032757226ea22fd;hpb=5c8de084e314e41f3dc2f605f6242283e930b803;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicUnifHint.ml b/helm/software/components/ng_refiner/nCicUnifHint.ml index 9532ba985..d166b1936 100644 --- a/helm/software/components/ng_refiner/nCicUnifHint.ml +++ b/helm/software/components/ng_refiner/nCicUnifHint.ml @@ -24,6 +24,16 @@ module DB = type db = DB.t +class status = + object + val db = DB.empty + method uhint_db = db + method set_uhint_db v = {< db = v >} + method set_unifhint_status + : 'status. < uhint_db : db; .. > as 'status -> 'self + = fun o -> {< db = o#uhint_db >} + end + let dummy = NCic.Const (NReference.reference_of_string "cic:/dummy_conv.dec");; let pair t1 t2 = (NCic.Appl [dummy;t1;t2]) ;; @@ -57,26 +67,21 @@ let index_hint hdb context t1 t2 precedence = NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] src ^ " |==> " ^ NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] data); *) - DB.index hdb src (precedence, data) + hdb#set_uhint_db (DB.index hdb#uhint_db src (precedence, data)) ;; -let empty_db = DB.empty ;; - let add_user_provided_hint db t precedence = - let u = UriManager.uri_of_string "cic:/foo/bar.con" in let c, a, b = let rec aux ctx = function | NCic.Appl l -> (match List.rev l with | b::a::_ -> ctx, a, b | _ -> assert false) - | NCic.Prod (n,s,t) -> - aux ((n, NCic.Decl s) :: ctx) t - | NCic.LetIn (n,ty,t,b) -> - aux ((n, NCic.Def (t,ty)) :: ctx) b + | NCic.Prod (n,s,t) -> aux ((n, NCic.Decl s) :: ctx) t + | NCic.LetIn (n,ty,t,b) -> aux ((n, NCic.Def (t,ty)) :: ctx) b | _ -> assert false in - aux [] (fst (OCic2NCic.convert_term u t)) + aux [] t in index_hint db c a b precedence ;; @@ -179,8 +184,8 @@ let look_for_hint hdb metasenv subst context t1 t2 = String.concat "|" (List.map (NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[]) (HintSet.elements ds)))); *) - let candidates1 = DB.retrieve_unifiables hdb (pair t1 t2) in - let candidates2 = DB.retrieve_unifiables hdb (pair t2 t1) in + let candidates1 = DB.retrieve_unifiables hdb#uhint_db (pair t1 t2) in + let candidates2 = DB.retrieve_unifiables hdb#uhint_db (pair t2 t1) in let candidates1 = List.map (fun (prec,ty) -> prec,true,saturate ~delta:max_int metasenv subst context ty 0)