X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fparamodulation%2Futils.ml;h=86c9c1430105e0948c4ba3274284b9b9b03caded;hb=e78cf74f8976cf0ca554f64baa9979d0423ee927;hp=6ac2132aaa8f203a945982c3f4ecb913868199f9;hpb=041ad23b567b9844ec187ad436595868441802f4;p=helm.git diff --git a/helm/software/components/tactics/paramodulation/utils.ml b/helm/software/components/tactics/paramodulation/utils.ml index 6ac2132aa..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;; @@ -98,6 +98,12 @@ 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 @@ -108,6 +114,8 @@ let rec remove_local_context = | 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 @@ -259,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 @@ -346,7 +354,7 @@ let compute_equality_weight (ty,left,right,o) = let compute_equality_weight e = let w = compute_equality_weight e in - let d = distance !goal_symbols (symbols_of_eq 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 @@ -500,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 @@ -546,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)); *) @@ -747,8 +764,7 @@ 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