X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fparamodulation%2Futils.ml;h=86c9c1430105e0948c4ba3274284b9b9b03caded;hb=152966d146348c74302df64e12c7644c00eb447e;hp=84de8800e7c8de566ff7e93cd0d7bec23c0fea9d;hpb=14621bf944fd8cae2d0f0bc8bc0e0f8123cbffa7;p=helm.git diff --git a/helm/software/components/tactics/paramodulation/utils.ml b/helm/software/components/tactics/paramodulation/utils.ml index 84de8800e..86c9c1430 100644 --- a/helm/software/components/tactics/paramodulation/utils.ml +++ b/helm/software/components/tactics/paramodulation/utils.ml @@ -25,7 +25,7 @@ (* $Id$ *) -let time = true;; +let time = false;; let debug = false;; let debug_metas = false;; let debug_res = false;; @@ -41,8 +41,6 @@ let print_metasenv metasenv = ;; - - let print_subst ?(prefix="\n") subst = String.concat prefix (List.map @@ -62,6 +60,8 @@ let string_of_comparison = function | Eq -> "=" | Incomparable -> "I" +type environment = Cic.metasenv * Cic.context * CicUniv.universe_graph + module OrderedTerm = struct type t = Cic.term @@ -98,11 +98,26 @@ let metas_of_term term = | C.Meta _ as t -> TermSet.singleton t | C.Appl l -> List.fold_left (fun res t -> TermSet.union res (aux t)) TermSet.empty l + | C.Lambda(n,s,t) -> + TermSet.union (aux s) (aux t) + | C.Prod(n,s,t) -> + TermSet.union (aux s) (aux t) + | C.LetIn(n,s,ty,t) -> + TermSet.union (aux s) (TermSet.union (aux ty) (aux t)) | t -> TermSet.empty (* TODO: maybe add other cases? *) in aux term ;; +let rec remove_local_context = + function + | Cic.Meta (i,_) -> Cic.Meta (i,[]) + | Cic.Appl l -> + Cic.Appl(List.map remove_local_context l) + | Cic.Prod (n,s,t) -> + Cic.Prod (n,remove_local_context s, remove_local_context t) + | t -> t + (************************* rpo ********************************) let number = [ @@ -252,7 +267,7 @@ let weight_of_term ?(consider_metas=true) ?(count_metas_occurrences=false) term | C.Cast (t1, t2) | C.Lambda (_, t1, t2) | C.Prod (_, t1, t2) - | C.LetIn (_, t1, t2) -> + | C.LetIn (_, t1, _, t2) -> let w1 = aux t1 in let w2 = aux t2 in w1 + w2 + 1 @@ -292,20 +307,82 @@ end module IntSet = Set.Make(OrderedInt) -let compute_equality_weight ty left right = +let goal_symbols = ref TermSet.empty + +let set_of_map m = + TermMap.fold (fun k _ s -> TermSet.add k s) m TermSet.empty +;; + +let set_goal_symbols term = + let m = symbols_of_term term in + goal_symbols := (set_of_map m) +;; + +let symbols_of_eq (ty,left,right,_) = + let sty = set_of_map (symbols_of_term ty) in + let sl = set_of_map (symbols_of_term left) in + let sr = set_of_map (symbols_of_term right) in + TermSet.union sty (TermSet.union sl sr) +;; + +let distance sgoal seq = + let s = TermSet.diff seq sgoal in + TermSet.cardinal s +;; + +let compute_equality_weight (ty,left,right,o) = + let factor = 2 in + match o with + | Lt -> + let w, m = (weight_of_term + ~consider_metas:true ~count_metas_occurrences:false right) in + w + (factor * (List.length m)) ; + | Le -> assert false + | Gt -> + let w, m = (weight_of_term + ~consider_metas:true ~count_metas_occurrences:false left) in + w + (factor * (List.length m)) ; + | Ge -> assert false + | Eq + | Incomparable -> + let w1, m1 = (weight_of_term + ~consider_metas:true ~count_metas_occurrences:false right) in + let w2, m2 = (weight_of_term + ~consider_metas:true ~count_metas_occurrences:false left) in + w1 + w2 + (factor * (List.length m1)) + (factor * (List.length m2)) +;; + +let compute_equality_weight e = + let w = compute_equality_weight e in + let d = 0 in (* distance !goal_symbols (symbols_of_eq e) in *) +(* + prerr_endline (Printf.sprintf "dist %s --- %s === %d" + (String.concat ", " (List.map (CicPp.ppterm) (TermSet.elements + !goal_symbols))) + (String.concat ", " (List.map (CicPp.ppterm) (TermSet.elements + (symbols_of_eq e)))) + d + ); +*) + w + d +;; + +(* old +let compute_equality_weight (ty,left,right,o) = let metasw = ref 0 in let weight_of t = let w, m = (weight_of_term ~consider_metas:true ~count_metas_occurrences:false t) in - metasw := !metasw + (2 * (List.length m)) ; + metasw := !metasw + (1 * (List.length m)) ; w in (* Warning: the following let cannot be expanded since it forces the right evaluation order!!!! *) - let w = (weight_of ty) + (weight_of left) + (weight_of right) in + let w = (weight_of ty) + (weight_of left) + (weight_of right) in + (* let w = weight_of (Cic.Appl [ty;left;right]) in *) w + !metasw ;; - +*) (* returns a "normalized" version of the polynomial weight wl (with type * weight list), i.e. a list sorted ascending by meta number, @@ -405,7 +482,6 @@ let compare_weights ?(normalize=false) | (m, _, n) when m > 0 && n > 0 -> Incomparable | _ -> assert false - ;; @@ -432,12 +508,21 @@ let rec aux_ordering ?(recursion=true) t1 t2 = | C.Const _, _ -> Lt | _, C.Const _ -> Gt - | C.MutInd (u1, _, _), C.MutInd (u2, _, _) -> compare_uris u1 u2 + | C.MutInd (u1, tno1, _), C.MutInd (u2, tno2, _) -> + let res = compare_uris u1 u2 in + if res <> Eq then res + else + let res = compare tno1 tno2 in + if res = 0 then Eq else if res < 0 then Lt else Gt | C.MutInd _, _ -> Lt | _, C.MutInd _ -> Gt - | C.MutConstruct (u1, _, _, _), C.MutConstruct (u2, _, _, _) -> - compare_uris u1 u2 + | C.MutConstruct (u1, tno1, cno1, _), C.MutConstruct (u2, tno2, cno2, _) -> + let res = compare_uris u1 u2 in + if res <> Eq then res + else + let res = compare (tno1,cno1) (tno2,cno2) in + if res = 0 then Eq else if res < 0 then Lt else Gt | C.MutConstruct _, _ -> Lt | _, C.MutConstruct _ -> Gt @@ -478,7 +563,7 @@ let nonrec_kbo_w (t1, w1) (t2, w2) = let nonrec_kbo t1 t2 = let w1 = weight_of_term t1 in let w2 = weight_of_term t2 in - (* + (* prerr_endline ("weight1 :"^(string_of_weight w1)); prerr_endline ("weight2 :"^(string_of_weight w2)); *) @@ -679,21 +764,12 @@ let guarded_simpl ?(debug=false) context t = if t = t' then t else begin let simpl_order = !compare_terms t t' in - if debug then - prerr_endline ("comparing "^(CicPp.ppterm t)^(CicPp.ppterm t')); + debug_print (lazy ("comparing "^(CicPp.ppterm t)^(CicPp.ppterm t'))); if simpl_order = Gt then (if debug then prerr_endline "GT";t') else (if debug then prerr_endline "NO_GT";t) end ;; -type equality_sign = Negative | Positive;; - -let string_of_sign = function - | Negative -> "Negative" - | Positive -> "Positive" -;; - - type pos = Left | Right let string_of_pos = function @@ -701,11 +777,7 @@ let string_of_pos = function | Right -> "Right" ;; +let metas_of_term t = + List.map fst (CicUtil.metas_of_term t) +;; -let eq_ind_URI () = LibraryObjects.eq_ind_URI ~eq:(LibraryObjects.eq_URI ()) -let eq_ind_r_URI () = LibraryObjects.eq_ind_r_URI ~eq:(LibraryObjects.eq_URI ()) -let sym_eq_URI () = LibraryObjects.sym_eq_URI ~eq:(LibraryObjects.eq_URI ()) -let eq_XURI () = - let s = UriManager.string_of_uri (LibraryObjects.eq_URI ()) in - UriManager.uri_of_string (s ^ "#xpointer(1/1/1)") -let trans_eq_URI () = LibraryObjects.trans_eq_URI ~eq:(LibraryObjects.eq_URI ())