X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fparamodulation%2Findexing.ml;h=5a8960101d21c2a513b4acc18223817c1aad27c7;hb=a3acd934eba07f24937e59c3c7a41db82d901025;hp=c45e19ab0de0862d05b2d9dab52b85ab13f24c50;hpb=44b3d34ddcc81a5e008cc8be7db102139af1d907;p=helm.git diff --git a/helm/ocaml/paramodulation/indexing.ml b/helm/ocaml/paramodulation/indexing.ml index c45e19ab0..5a8960101 100644 --- a/helm/ocaml/paramodulation/indexing.ml +++ b/helm/ocaml/paramodulation/indexing.ml @@ -1,53 +1,138 @@ -(* type naif_indexing = - (Cic.term * ((bool * Inference.equality) list)) list -;; *) -type pos = Left | Right ;; +type retrieval_mode = Matching | Unification;; -let head_of_term = function - | Cic.Appl (hd::tl) -> hd - | t -> t + +let print_candidates mode term res = + let _ = + match mode with + | Matching -> + Printf.printf "| candidates Matching %s\n" (CicPp.ppterm term) + | Unification -> + Printf.printf "| candidates Unification %s\n" (CicPp.ppterm term) + in + print_endline + (String.concat "\n" + (List.map + (fun (p, e) -> + Printf.sprintf "| (%s, %s)" (Utils.string_of_pos p) + (Inference.string_of_equality e)) + res)); + print_endline "|"; ;; -let index table eq = - let _, (_, l, r, ordering), _, _ = eq in - let hl = head_of_term l in - let hr = head_of_term r in - let index x pos = - let x_entry = try Hashtbl.find table x with Not_found -> [] in - Hashtbl.replace table x ((pos, eq)::x_entry) - in - let _ = - match ordering with - | Utils.Gt -> - index hl Left - | Utils.Lt -> - index hr Right - | _ -> index hl Left; index hr Right +let indexing_retrieval_time = ref 0.;; + + +(* let my_apply_subst subst term = *) +(* let module C = Cic in *) +(* let lookup lift_amount meta = *) +(* match meta with *) +(* | C.Meta (i, _) -> ( *) +(* try *) +(* let _, (_, t, _) = List.find (fun (m, _) -> m = i) subst in *) +(* (\* CicSubstitution.lift lift_amount *\)t *) +(* with Not_found -> meta *) +(* ) *) +(* | _ -> assert false *) +(* in *) +(* let rec apply_aux lift_amount = function *) +(* | C.Meta (i, l) as t -> lookup lift_amount t *) +(* | C.Appl l -> C.Appl (List.map (apply_aux lift_amount) l) *) +(* | C.Prod (nn, s, t) -> *) +(* C.Prod (nn, apply_aux lift_amount s, apply_aux (lift_amount+1) t) *) +(* | C.Lambda (nn, s, t) -> *) +(* C.Lambda (nn, apply_aux lift_amount s, apply_aux (lift_amount+1) t) *) +(* | t -> t *) +(* in *) +(* apply_aux 0 term *) +(* ;; *) + + +(* let apply_subst subst term = *) +(* Printf.printf "| apply_subst:\n| subst: %s\n| term: %s\n" *) +(* (Utils.print_subst ~prefix:" ; " subst) (CicPp.ppterm term); *) +(* let res = my_apply_subst subst term in *) +(* (\* let res = CicMetaSubst.apply_subst subst term in *\) *) +(* Printf.printf "| res: %s\n" (CicPp.ppterm res); *) +(* print_endline "|"; *) +(* res *) +(* ;; *) + +(* let apply_subst = my_apply_subst *) +let apply_subst = CicMetaSubst.apply_subst + + +let apply_subst = + let profile = CicUtil.profile "apply_subst" in + (fun s a -> profile (apply_subst s) a) +;; + + +(* +let empty_table () = + Path_indexing.PSTrie.empty +;; + +let index = Path_indexing.index +and remove_index = Path_indexing.remove_index +and in_index = Path_indexing.in_index;; + +let get_candidates mode trie term = + let t1 = Unix.gettimeofday () in + let res = + let s = + match mode with + | Matching -> Path_indexing.retrieve_generalizations trie term + | Unification -> Path_indexing.retrieve_unifiables trie term +(* Path_indexing.retrieve_all trie term *) + in + Path_indexing.PosEqSet.elements s in -(* index hl Left; *) -(* index hr Right; *) - table +(* print_candidates mode term res; *) + let t2 = Unix.gettimeofday () in + indexing_retrieval_time := !indexing_retrieval_time +. (t2 -. t1); + res +;; +*) + + +let empty_table () = + Discrimination_tree.DiscriminationTree.empty ;; +let index = Discrimination_tree.index +and remove_index = Discrimination_tree.remove_index +and in_index = Discrimination_tree.in_index;; -let remove_index table eq = - let _, (_, l, r, ordering), _, _ = eq in - let hl = head_of_term l - and hr = head_of_term r in - let remove_index x pos = - let x_entry = try Hashtbl.find table x with Not_found -> [] in - let newentry = List.filter (fun e -> e <> (pos, eq)) x_entry in - Hashtbl.replace table x newentry +let get_candidates mode tree term = + let t1 = Unix.gettimeofday () in + let res = + let s = + match mode with + | Matching -> Discrimination_tree.retrieve_generalizations tree term + | Unification -> Discrimination_tree.retrieve_unifiables tree term + in + Discrimination_tree.PosEqSet.elements s in - remove_index hl Left; - remove_index hr Right; - table +(* print_candidates mode term res; *) + let t2 = Unix.gettimeofday () in + indexing_retrieval_time := !indexing_retrieval_time +. (t2 -. t1); + res ;; -let rec find_matches unif_fun metasenv context ugraph lift_amount term = +(* let get_candidates = *) +(* let profile = CicUtil.profile "Indexing.get_candidates" in *) +(* (fun mode tree term -> profile (get_candidates mode tree) term) *) +(* ;; *) + + +let match_unif_time_ok = ref 0.;; +let match_unif_time_no = ref 0.;; + + +let rec find_matches metasenv context ugraph lift_amount term = let module C = Cic in let module U = Utils in let module S = CicSubstitution in @@ -55,67 +140,176 @@ let rec find_matches unif_fun metasenv context ugraph lift_amount term = let module HL = HelmLibraryObjects in let cmp = !Utils.compare_terms in let names = Utils.names_of_context context in -(* Printf.printf "CHIAMO find_matches (%s) su: %s\n" *) -(* (if unif_fun == Inference.matching then "MATCHING" *) -(* else if unif_fun == CicUnification.fo_unif then "UNIFICATION" *) -(* else "??????????") *) -(* (CicPp.pp term names); *) function | [] -> None | candidate::tl -> let pos, (proof, (ty, left, right, o), metas, args) = candidate in let do_match c other eq_URI = -(* Printf.printf "provo con %s: %s, %s\n\n" *) -(* (if unif_fun == Inference.matching then "MATCHING" *) -(* else if unif_fun == CicUnification.fo_unif then "UNIFICATION" *) -(* else "??????????") *) -(* (CicPp.pp term names) *) -(* (CicPp.pp (S.lift lift_amount c) names); *) let subst', metasenv', ugraph' = -(* Inference.matching (metasenv @ metas) context term *) -(* (S.lift lift_amount c) ugraph *) - unif_fun (metasenv @ metas) context - term (S.lift lift_amount c) ugraph + let t1 = Unix.gettimeofday () in + try + let r = + Inference.matching (metasenv @ metas) context + term (S.lift lift_amount c) ugraph in + let t2 = Unix.gettimeofday () in + match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1); + r + with e -> + let t2 = Unix.gettimeofday () in + match_unif_time_no := !match_unif_time_no +. (t2 -. t1); + raise e in -(* let names = U.names_of_context context in *) -(* Printf.printf "MATCH FOUND: %s, %s\n" *) -(* (CicPp.pp term names) (CicPp.pp (S.lift lift_amount c) names); *) - Some (C.Rel (1 + lift_amount), subst', metasenv', ugraph', - (candidate, eq_URI)) -(* (proof, ty, c, other, eq_URI)) *) + Some (C.Rel (1 + lift_amount), subst', metasenv', ugraph', + (candidate, eq_URI)) in let c, other, eq_URI = - if pos = Left then left, right, HL.Logic.eq_ind_URI + if pos = Utils.Left then left, right, HL.Logic.eq_ind_URI else right, left, HL.Logic.eq_ind_r_URI in if o <> U.Incomparable then try -(* print_endline "SONO QUI!"; *) - let res = do_match c other eq_URI in -(* print_endline "RITORNO RES"; *) - res + do_match c other eq_URI with e -> -(* Printf.printf "ERRORE!: %s\n" (Printexc.to_string e); *) - find_matches unif_fun metasenv context ugraph lift_amount term tl + find_matches metasenv context ugraph lift_amount term tl else let res = try do_match c other eq_URI with e -> None in match res with | Some (_, s, _, _, _) -> - let c' = M.apply_subst s c - and other' = M.apply_subst s other in + let c' = (* M. *)apply_subst s c + and other' = (* M. *)apply_subst s other in let order = cmp c' other' in let names = U.names_of_context context in -(* Printf.printf "c': %s\nother': %s\norder: %s\n\n" *) -(* (CicPp.pp c' names) (CicPp.pp other' names) *) -(* (U.string_of_comparison order); *) -(* if cmp (M.apply_subst s c) (M.apply_subst s other) = U.Gt then *) if order = U.Gt then res else - find_matches unif_fun metasenv context ugraph - lift_amount term tl + find_matches metasenv context ugraph lift_amount term tl | None -> - find_matches unif_fun metasenv context ugraph lift_amount term tl + find_matches metasenv context ugraph lift_amount term tl +;; + + +let rec find_all_matches ?(unif_fun=Inference.unification) + metasenv context ugraph lift_amount term = + let module C = Cic in + let module U = Utils in + let module S = CicSubstitution in + let module M = CicMetaSubst in + let module HL = HelmLibraryObjects in + let cmp = !Utils.compare_terms in + let names = Utils.names_of_context context in + function + | [] -> [] + | candidate::tl -> + let pos, (proof, (ty, left, right, o), metas, args) = candidate in + let do_match c other eq_URI = + let subst', metasenv', ugraph' = + let t1 = Unix.gettimeofday () in + try + let r = + unif_fun (metasenv @ metas) context + term (S.lift lift_amount c) ugraph in + let t2 = Unix.gettimeofday () in + match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1); + r + with e -> + let t2 = Unix.gettimeofday () in + match_unif_time_no := !match_unif_time_no +. (t2 -. t1); + raise e + in + (C.Rel (1 + lift_amount), subst', metasenv', ugraph', + (candidate, eq_URI)) + in + let c, other, eq_URI = + if pos = Utils.Left then left, right, HL.Logic.eq_ind_URI + else right, left, HL.Logic.eq_ind_r_URI + in + if o <> U.Incomparable then + try + let res = do_match c other eq_URI in + res::(find_all_matches ~unif_fun metasenv context ugraph + lift_amount term tl) + with e -> + find_all_matches ~unif_fun metasenv context ugraph + lift_amount term tl + else + try + let res = do_match c other eq_URI in + match res with + | _, s, _, _, _ -> + let c' = (* M. *)apply_subst s c + and other' = (* M. *)apply_subst s other in + let order = cmp c' other' in + let names = U.names_of_context context in + if order <> U.Lt && order <> U.Le then + res::(find_all_matches ~unif_fun metasenv context ugraph + lift_amount term tl) + else + find_all_matches ~unif_fun metasenv context ugraph + lift_amount term tl + with e -> + find_all_matches ~unif_fun metasenv context ugraph + lift_amount term tl +;; + + +let subsumption env table target = + let _, (ty, left, right, _), tmetas, _ = target in + let metasenv, context, ugraph = env in + let metasenv = metasenv @ tmetas in + let samesubst subst subst' = + let tbl = Hashtbl.create (List.length subst) in + List.iter (fun (m, (c, t1, t2)) -> Hashtbl.add tbl m (c, t1, t2)) subst; + List.for_all + (fun (m, (c, t1, t2)) -> + try + let c', t1', t2' = Hashtbl.find tbl m in + if (c = c') && (t1 = t1') && (t2 = t2') then true + else false + with Not_found -> + true) + subst' + in + let leftr = + match left with + | Cic.Meta _ -> [] + | _ -> + let leftc = get_candidates Matching table left in + find_all_matches ~unif_fun:Inference.matching + metasenv context ugraph 0 left leftc + in + let ok what (_, subst, menv, ug, ((pos, (_, (_, l, r, o), _, _)), _)) = + try + let other = if pos = Utils.Left then r else l in + let subst', menv', ug' = + let t1 = Unix.gettimeofday () in + try + let r = + Inference.matching metasenv context what other ugraph in + let t2 = Unix.gettimeofday () in + match_unif_time_ok := !match_unif_time_ok +. (t2 -. t1); + r + with e -> + let t2 = Unix.gettimeofday () in + match_unif_time_no := !match_unif_time_no +. (t2 -. t1); + raise e + in + samesubst subst subst' + with e -> + false + in + let r = List.exists (ok right) leftr in + if r then + true + else + let rightr = + match right with + | Cic.Meta _ -> [] + | _ -> + let rightc = get_candidates Matching table right in + find_all_matches ~unif_fun:Inference.matching + metasenv context ugraph 0 right rightc + in + List.exists (ok left) rightr ;; @@ -124,14 +318,12 @@ let rec demodulate_term metasenv context ugraph table lift_amount term = let module S = CicSubstitution in let module M = CicMetaSubst in let module HL = HelmLibraryObjects in - let hd_term = head_of_term term in - let candidates = try Hashtbl.find table hd_term with Not_found -> [] in + let candidates = get_candidates Matching table term in match term with | C.Meta _ -> None | term -> let res = - find_matches Inference.matching metasenv context ugraph - lift_amount term candidates + find_matches metasenv context ugraph lift_amount term candidates in if res <> None then res @@ -179,12 +371,12 @@ let rec demodulate_term metasenv context ugraph table lift_amount term = subst, menv, ug, eq_found) ) | t -> -(* Printf.printf "Ne` Appl ne` Prod: %s\n" *) -(* (CicPp.pp t (Utils.names_of_context context)); *) None ;; +let build_newtarget_time = ref 0.;; + let rec demodulation newmeta env table target = let module C = Cic in let module S = CicSubstitution in @@ -192,17 +384,14 @@ let rec demodulation newmeta env table target = let module HL = HelmLibraryObjects in let metasenv, context, ugraph = env in let proof, (eq_ty, left, right, order), metas, args = target in -(* let _ = *) -(* let names = Utils.names_of_context context in *) -(* Printf.printf "demodulation %s = %s\n" *) -(* (CicPp.pp left names) (CicPp.pp right names) *) -(* in *) let metasenv' = metasenv @ metas in let build_newtarget is_left (t, subst, menv, ug, (eq_found, eq_URI)) = + let time1 = Unix.gettimeofday () in + let pos, (proof', (ty, what, other, _), menv', args') = eq_found in - let what, other = if pos = Left then what, other else other, what in + let what, other = if pos = Utils.Left then what, other else other, what in let newterm, newproof = - let bo = M.apply_subst subst (S.subst other t) in + let bo = (* M. *)apply_subst subst (S.subst other t) in let bo'' = C.Appl ([C.MutInd (HL.Logic.eq_URI, 0, []); S.lift 1 eq_ty] @ @@ -210,8 +399,9 @@ let rec demodulation newmeta env table target = in let t' = C.Lambda (C.Anonymous, ty, bo'') in bo, - M.apply_subst subst (C.Appl [C.Const (eq_URI, []); ty; what; t'; - proof; other; proof']) + C.Implicit None +(* (\* M. *\)apply_subst subst (C.Appl [C.Const (eq_URI, []); ty; what; t'; *) +(* proof; other; proof']) *) in let left, right = if is_left then newterm, right else left, newterm in let m = @@ -224,22 +414,33 @@ let rec demodulation newmeta env table target = args in let ordering = !Utils.compare_terms left right in + + let time2 = Unix.gettimeofday () in + build_newtarget_time := !build_newtarget_time +. (time2 -. time1); + newmeta, (newproof, (eq_ty, left, right, ordering), newmetasenv, newargs) in +(* let build_newtarget = *) +(* let profile = CicUtil.profile "Indexing.demodulation.build_newtarget" in *) +(* (fun a b -> profile (build_newtarget a) b) *) +(* in *) let res = demodulate_term metasenv' context ugraph table 0 left in + let build_identity (p, (t, l, r, o), m, a) = + match o with + | Utils.Gt -> (p, (t, r, r, Utils.Eq), m, a) + | _ -> (p, (t, l, l, Utils.Eq), m, a) + in match res with | Some t -> let newmeta, newtarget = build_newtarget true t in if (Inference.is_identity (metasenv', context, ugraph) newtarget) || (Inference.meta_convertibility_eq target newtarget) then newmeta, newtarget - else ( -(* Printf.printf "Going on 1:\ntarget: %s\nnewtarget: %s\n%s\n\n" *) -(* (Inference.string_of_equality ~env target) *) -(* (Inference.string_of_equality ~env newtarget) *) -(* (string_of_bool (target = newtarget)); *) - demodulation newmeta env table newtarget - ) + else +(* if subsumption env table newtarget then *) +(* newmeta, build_identity newtarget *) +(* else *) + demodulation newmeta env table newtarget | None -> let res = demodulate_term metasenv' context ugraph table 0 right in match res with @@ -248,73 +449,22 @@ let rec demodulation newmeta env table target = if (Inference.is_identity (metasenv', context, ugraph) newtarget) || (Inference.meta_convertibility_eq target newtarget) then newmeta, newtarget - else ( -(* Printf.printf "Going on 2:\ntarget: %s\nnewtarget: %s\n\n" *) -(* (Inference.string_of_equality ~env target) *) -(* (Inference.string_of_equality ~env newtarget); *) - demodulation newmeta env table newtarget - ) + else +(* if subsumption env table newtarget then *) +(* newmeta, build_identity newtarget *) +(* else *) + demodulation newmeta env table newtarget | None -> newmeta, target ;; -let rec find_all_matches metasenv context ugraph lift_amount term = - let module C = Cic in - let module U = Utils in - let module S = CicSubstitution in - let module M = CicMetaSubst in - let module HL = HelmLibraryObjects in - let cmp = !Utils.compare_terms in - let names = Utils.names_of_context context in - function - | [] -> [] - | candidate::tl -> - let pos, (proof, (ty, left, right, o), metas, args) = candidate in - let do_match c other eq_URI = - let subst', metasenv', ugraph' = - CicUnification.fo_unif (metasenv @ metas) context - term (S.lift lift_amount c) ugraph - in - (C.Rel (1 + lift_amount), subst', metasenv', ugraph', - (candidate, eq_URI)) - in - let c, other, eq_URI = - if pos = Left then left, right, HL.Logic.eq_ind_URI - else right, left, HL.Logic.eq_ind_r_URI - in - if o <> U.Incomparable then - try - let res = do_match c other eq_URI in - res::(find_all_matches metasenv context ugraph lift_amount term tl) - with e -> - find_all_matches metasenv context ugraph lift_amount term tl - else - try - let res = do_match c other eq_URI in - match res with - | _, s, _, _, _ -> - let c' = M.apply_subst s c - and other' = M.apply_subst s other in - let order = cmp c' other' in - let names = U.names_of_context context in - if order <> U.Lt && order <> U.Le then - res::(find_all_matches metasenv context ugraph - lift_amount term tl) - else - find_all_matches metasenv context ugraph lift_amount term tl - with e -> - find_all_matches metasenv context ugraph lift_amount term tl -;; - - let rec betaexpand_term metasenv context ugraph table lift_amount term = let module C = Cic in let module S = CicSubstitution in let module M = CicMetaSubst in let module HL = HelmLibraryObjects in - let hd_term = head_of_term term in - let candidates = try Hashtbl.find table hd_term with Not_found -> [] in + let candidates = get_candidates Unification table term in let res, lifted_term = match term with | C.Meta (i, l) -> @@ -401,18 +551,10 @@ let rec betaexpand_term metasenv context ugraph table lift_amount term = match term with | C.Meta _ -> res, lifted_term | term -> -(* let names = Utils.names_of_context context in *) -(* Printf.printf "CHIAMO find_all_matches su: %s\n" (CicPp.pp term names); *) let r = find_all_matches metasenv context ugraph lift_amount term candidates in r @ res, lifted_term -(* match *) -(* find_all_matches metasenv context ugraph lift_amount term candidates *) -(* with *) -(* | None -> res, lifted_term *) -(* | Some r -> *) -(* r::res, lifted_term *) ;; @@ -423,17 +565,18 @@ let superposition_left (metasenv, context, ugraph) table target = let module HL = HelmLibraryObjects in let module CR = CicReduction in let module U = Utils in -(* print_endline "superposition_left"; *) let proof, (eq_ty, left, right, ordering), _, _ = target in let expansions, _ = let term = if ordering = U.Gt then left else right in betaexpand_term metasenv context ugraph table 0 term in let build_new (bo, s, m, ug, (eq_found, eq_URI)) = + let time1 = Unix.gettimeofday () in + let pos, (proof', (ty, what, other, _), menv', args') = eq_found in - let what, other = if pos = Left then what, other else other, what in + let what, other = if pos = Utils.Left then what, other else other, what in let newgoal, newproof = - let bo' = M.apply_subst s (S.subst other bo) in + let bo' = (* M. *)apply_subst s (S.subst other bo) in let bo'' = C.Appl ( [C.MutInd (HL.Logic.eq_URI, 0, []); @@ -443,15 +586,24 @@ let superposition_left (metasenv, context, ugraph) table target = in let t' = C.Lambda (C.Anonymous, ty, bo'') in bo', - M.apply_subst s - (C.Appl [C.Const (eq_URI, []); ty; what; t'; - proof; other; proof']) + C.Implicit None +(* (\* M. *\)apply_subst s *) +(* (C.Appl [C.Const (eq_URI, []); ty; what; t'; *) +(* proof; other; proof']) *) in let left, right = if ordering = U.Gt then newgoal, right else left, newgoal in let neworder = !Utils.compare_terms left right in + + let time2 = Unix.gettimeofday () in + build_newtarget_time := !build_newtarget_time +. (time2 -. time1); + (newproof, (eq_ty, left, right, neworder), [], []) in +(* let build_new = *) +(* let profile = CicUtil.profile "Inference.superposition_left.build_new" in *) +(* (fun e -> profile build_new e) *) +(* in *) List.map build_new expansions ;; @@ -463,7 +615,6 @@ let superposition_right newmeta (metasenv, context, ugraph) table target = let module HL = HelmLibraryObjects in let module CR = CicReduction in let module U = Utils in -(* print_endline "superposition_right"; *) let eqproof, (eq_ty, left, right, ordering), newmetas, args = target in let metasenv' = metasenv @ newmetas in let maxmeta = ref newmeta in @@ -475,7 +626,7 @@ let superposition_right newmeta (metasenv, context, ugraph) table target = let res l r = List.filter (fun (_, subst, _, _, _) -> - let subst = M.apply_subst subst in + let subst = (* M. *)apply_subst subst in let o = !Utils.compare_terms (subst l) (subst r) in o <> U.Lt && o <> U.Le) (fst (betaexpand_term metasenv' context ugraph table 0 l)) @@ -483,10 +634,13 @@ let superposition_right newmeta (metasenv, context, ugraph) table target = (res left right), (res right left) in let build_new ordering (bo, s, m, ug, (eq_found, eq_URI)) = + + let time1 = Unix.gettimeofday () in + let pos, (proof', (ty, what, other, _), menv', args') = eq_found in - let what, other = if pos = Left then what, other else other, what in + let what, other = if pos = Utils.Left then what, other else other, what in let newgoal, newproof = - let bo' = M.apply_subst s (S.subst other bo) in + let bo' = (* M. *)apply_subst s (S.subst other bo) in let bo'' = C.Appl ( [C.MutInd (HL.Logic.eq_URI, 0, []); S.lift 1 eq_ty] @ @@ -495,29 +649,36 @@ let superposition_right newmeta (metasenv, context, ugraph) table target = in let t' = C.Lambda (C.Anonymous, ty, bo'') in bo', - M.apply_subst s - (C.Appl [C.Const (eq_URI, []); ty; what; t'; - eqproof; other; proof']) + C.Implicit None +(* (\* M. *\)apply_subst s *) +(* (C.Appl [C.Const (eq_URI, []); ty; what; t'; *) +(* eqproof; other; proof']) *) in let newmeta, newequality = let left, right = - if ordering = U.Gt then newgoal, M.apply_subst s right - else M.apply_subst s left, newgoal in + if ordering = U.Gt then newgoal, (* M. *)apply_subst s right + else (* M. *)apply_subst s left, newgoal in let neworder = !Utils.compare_terms left right and newmenv = newmetas @ menv' and newargs = args @ args' in let eq' = (newproof, (eq_ty, left, right, neworder), newmenv, newargs) and env = (metasenv, context, ugraph) in -(* Printf.printf "eq' prima di fix_metas: %s\n" *) -(* (Inference.string_of_equality eq' ~env); *) let newm, eq' = Inference.fix_metas !maxmeta eq' in -(* Printf.printf "eq' dopo fix_metas: %s\n" *) -(* (Inference.string_of_equality eq' ~env); *) newm, eq' in maxmeta := newmeta; + + let time2 = Unix.gettimeofday () in + build_newtarget_time := !build_newtarget_time +. (time2 -. time1); + newequality in + +(* let build_new = *) +(* let profile = CicUtil.profile "Indexing.superposition_right.build_new" in *) +(* (fun o e -> profile (build_new o) e) *) +(* in *) + let new1 = List.map (build_new U.Gt) res1 and new2 = List.map (build_new U.Lt) res2 in let ok = function