X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fauto.ml;h=f78dbce75976c26416cccd679af13af08694bbf9;hb=34fc94bfcd6172a4f856638213e3d50dc81444ca;hp=9be698dcf286e48f4966e9bfb27f7473a2a9f85c;hpb=cc23f034c9419186602d9250456241f2eba90d7c;p=helm.git diff --git a/helm/software/components/tactics/auto.ml b/helm/software/components/tactics/auto.ml index 9be698dcf..f78dbce75 100644 --- a/helm/software/components/tactics/auto.ml +++ b/helm/software/components/tactics/auto.ml @@ -1,4 +1,5 @@ (* Copyright (C) 2002, HELM Team. + * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -30,12 +31,127 @@ let debug = false;; let debug_print s = if debug then prerr_endline (Lazy.force s);; + +let mk_irl ctx = CicMkImplicit.identity_relocation_list_for_metavariable ctx;; +let ugraph = CicUniv.oblivion_ugraph;; +let typeof = CicTypeChecker.type_of_aux';; +let ppterm ctx t = + let names = List.map (function None -> None | Some (x,_) -> Some x) ctx in + CicPp.pp t names +;; +let is_propositional context sort = + match CicReduction.whd context sort with + | Cic.Sort Cic.Prop + | Cic.Sort (Cic.CProp _) -> true + | _-> false +;; +let is_in_prop context subst metasenv ty = + let sort,u = typeof ~subst metasenv context ty CicUniv.oblivion_ugraph in + is_propositional context sort +;; + +exception NotConvertible;; + +let check_proof_is_valid proof metasenv context goalty = + if debug then + begin + try + let ty,u = typeof metasenv context proof CicUniv.oblivion_ugraph in + let b,_ = CicReduction.are_convertible context ty goalty u in + if not b then raise NotConvertible else b + with _ -> + let names = + List.map (function None -> None | Some (x,_) -> Some x) context + in + debug_print (lazy ("PROOF:" ^ CicPp.pp proof names)); + (* debug_print (lazy ("PROOFTY:" ^ CicPp.pp ty names)); *) + debug_print (lazy ("GOAL:" ^ CicPp.pp goalty names)); + debug_print (lazy ("MENV:" ^ CicMetaSubst.ppmetasenv [] metasenv)); + false + end + else true +;; + +let assert_proof_is_valid proof metasenv context goalty = + assert (check_proof_is_valid proof metasenv context goalty) +;; + +let assert_subst_are_disjoint subst subst' = + if debug then + assert(List.for_all + (fun (i,_) -> List.for_all (fun (j,_) -> i<>j) subst') + subst) + else () +;; + +let split_goals_in_prop metasenv subst gl = + List.partition + (fun g -> + let _,context,ty = CicUtil.lookup_meta g metasenv in + try + let sort,u = typeof ~subst metasenv context ty ugraph in + is_propositional context sort + with + | CicTypeChecker.AssertFailure s + | CicTypeChecker.TypeCheckerFailure s -> + debug_print + (lazy ("NON TIPA" ^ ppterm context (CicMetaSubst.apply_subst subst ty))); + debug_print s; + false) + (* FIXME... they should type! *) + gl +;; + +let split_goals_with_metas metasenv subst gl = + List.partition + (fun g -> + let _,context,ty = CicUtil.lookup_meta g metasenv in + let ty = CicMetaSubst.apply_subst subst ty in + CicUtil.is_meta_closed ty) + gl +;; + +let order_new_goals metasenv subst open_goals ppterm = + let prop,rest = split_goals_in_prop metasenv subst open_goals in + let closed_prop, open_prop = split_goals_with_metas metasenv subst prop in + let closed_type, open_type = split_goals_with_metas metasenv subst rest in + let open_goals = + (List.map (fun x -> x,P) (open_prop @ closed_prop)) + @ + (List.map (fun x -> x,T) (open_type @ closed_type)) + in + let tys = + List.map + (fun (i,sort) -> + let _,_,ty = CicUtil.lookup_meta i metasenv in i,ty,sort) open_goals + in + debug_print (lazy (" OPEN: "^ + String.concat "\n" + (List.map + (function + | (i,t,P) -> string_of_int i ^ ":"^ppterm t^ "Prop" + | (i,t,T) -> string_of_int i ^ ":"^ppterm t^ "Type") + tys))); + open_goals +;; + +let is_an_equational_goal = function + | Cic.Appl [Cic.MutInd(u,_,_);_;_;_] when LibraryObjects.is_eq_URI u -> true + | _ -> false +;; + +type auto_params = Cic.term list * (string * string) list + let elems = ref [] ;; (* closing a term w.r.t. its metavariables very naif version: it does not take dependencies properly into account *) let naif_closure ?(prefix_name="xxx_") t metasenv context = + let in_term t (i,_,_) = + List.exists (fun (j,_) -> j=i) (CicUtil.metas_of_term t) + in + let metasenv = List.filter (in_term t) metasenv in let metasenv = ProofEngineHelpers.sort_metasenv metasenv in let n = List.length metasenv in let what = List.map (fun (i,cc,ty) -> Cic.Meta(i,[])) metasenv in @@ -60,17 +176,17 @@ let naif_closure ?(prefix_name="xxx_") t metasenv context = CicSubstitution.lift n ty,t)) (n-1,body) metasenv in - t + t, List.length metasenv ;; let lambda_close ?prefix_name t menv ctx = - let t = naif_closure ?prefix_name t menv ctx in + let t, num_lambdas = naif_closure ?prefix_name t menv ctx in List.fold_left (fun (t,i) -> function | None -> CicSubstitution.subst (Cic.Implicit None) t,i (* delift *) | Some (name, Cic.Decl ty) -> Cic.Lambda (name, ty, t),i+1 | Some (name, Cic.Def (bo, ty)) -> Cic.LetIn (name, bo, ty, t),i+1) - (t,List.length menv) ctx + (t,num_lambdas) ctx ;; (* functions for retrieving theorems *) @@ -88,7 +204,7 @@ let find_library_theorems dbd proof goal = let terms = List.map CicUtil.term_of_uri univ in List.map (fun t -> - (t,fst(CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph))) + (t,fst(CicTypeChecker.type_of_aux' [] [] t CicUniv.oblivion_ugraph))) terms let find_context_theorems context metasenv = @@ -117,6 +233,15 @@ let partition_equalities = let default_auto maxm _ _ cache _ _ _ _ = [],cache,maxm ;; +(* giusto per provare che succede +let is_unit_equation context metasenv oldnewmeta term = + let head, metasenv, args, newmeta = + TermUtil.saturate_term oldnewmeta metasenv context term 0 + in + let newmetas = + List.filter (fun (i,_,_) -> i >= oldnewmeta) metasenv + in + Some (args,metasenv,newmetas,head,newmeta) *) let is_unit_equation context metasenv oldnewmeta term = let head, metasenv, args, newmeta = @@ -129,13 +254,9 @@ let is_unit_equation context metasenv oldnewmeta term = let _,_,mt = CicUtil.lookup_meta i metasenv in let sort,u = CicTypeChecker.type_of_aux' metasenv context mt - CicUniv.empty_ugraph - in - let b, _ = - CicReduction.are_convertible ~metasenv context - sort (Cic.Sort Cic.Prop) u + CicUniv.oblivion_ugraph in - if b then Some i else None + if is_propositional context sort then Some i else None | _ -> assert false) args in @@ -147,7 +268,8 @@ let is_unit_equation context metasenv oldnewmeta term = else None ;; -let get_candidates universe cache t = +let get_candidates skip_trie_filtering universe cache t = + let t = if skip_trie_filtering then Cic.Meta(0,[]) else t in let candidates= (Universe.get_candidates universe t)@(AutoCache.get_candidates cache t) in @@ -161,15 +283,21 @@ let get_candidates universe cache t = let only signature context metasenv t = try let ty,_ = - CicTypeChecker.type_of_aux' metasenv context t CicUniv.empty_ugraph + CicTypeChecker.type_of_aux' metasenv context t CicUniv.oblivion_ugraph in let consts = MetadataConstraints.constants_of ty in let b = MetadataConstraints.UriManagerSet.subset consts signature in +(* if b then (prerr_endline ("keeping " ^ (CicPp.ppterm t)); b) *) if b then b else let ty' = unfold context ty in let consts' = MetadataConstraints.constants_of ty' in - MetadataConstraints.UriManagerSet.subset consts' signature + let b = MetadataConstraints.UriManagerSet.subset consts' signature in +(* + if not b then prerr_endline ("filtering " ^ (CicPp.ppterm t)) + else prerr_endline ("keeping " ^ (CicPp.ppterm t)); +*) + b with | CicTypeChecker.TypeCheckerFailure _ -> assert false | ProofEngineTypes.Fail _ -> false (* unfold may fail *) @@ -188,11 +316,13 @@ let retrieve_equations dont_filter signature universe cache context metasenv = let eq_uri = UriManager.strip_xpointer eq_uri in let fake= Cic.Meta(-1,[]) in let fake_eq = Cic.Appl [Cic.MutInd (eq_uri,0, []);fake;fake;fake] in - let candidates = get_candidates universe cache fake_eq in + let candidates = get_candidates false universe cache fake_eq in if dont_filter then candidates - else - let candidates = List.filter not_default_eq_term candidates in - List.filter (only signature context metasenv) candidates + else let eq_uri = UriManager.uri_of_uriref eq_uri 0 None in + (* let candidates = List.filter not_default_eq_term candidates in *) + List.filter + (only (MetadataConstraints.UriManagerSet.add eq_uri signature) + context metasenv) candidates let build_equality bag head args proof newmetas maxmeta = match head with @@ -236,6 +366,7 @@ let empty_tables = Saturation.make_passive [], Equality.mk_equality_bag) + let init_cache_and_tables ?dbd use_library paramod use_context dont_filter universe (proof, goal) = @@ -257,7 +388,7 @@ let init_cache_and_tables (lazy ("ho trovato nella libreria " ^ (string_of_int (List.length lt)))); let cache = cache_add_list cache context (ct@lt) in let equations = - retrieve_equations dont_filter signature universe cache context metasenv + retrieve_equations dont_filter (* true *) signature universe cache context metasenv in debug_print (lazy ("ho trovato equazioni n. "^(string_of_int (List.length equations)))); @@ -266,7 +397,7 @@ let init_cache_and_tables (fun t -> let ty,_ = CicTypeChecker.type_of_aux' - metasenv context t CicUniv.empty_ugraph + metasenv context t CicUniv.oblivion_ugraph in (* retrieve_equations could also return flexible terms *) if is_an_equality ty then Some(t,ty) @@ -283,7 +414,7 @@ let init_cache_and_tables in (* SIMPLIFICATION STEP let equalities = - let env = (metasenv, context, CicUniv.empty_ugraph) in + let env = (metasenv, context, CicUniv.oblivion_ugraph) in let eq_uri = HExtlib.unopt (LibraryObjects.eq_URI()) in Saturation.simplify_equalities bag eq_uri env units in @@ -310,13 +441,9 @@ let fill_hypothesis context metasenv oldnewmeta term tables (universe:Universe.u let _,_,mt = CicUtil.lookup_meta i metasenv in let sort,u = CicTypeChecker.type_of_aux' metasenv context mt - CicUniv.empty_ugraph - in - let b, _ = - CicReduction.are_convertible ~metasenv context - sort (Cic.Sort Cic.Prop) u + CicUniv.oblivion_ugraph in - if b then Some i else None + if is_propositional context sort then Some i else None | _ -> assert false) args in @@ -399,7 +526,8 @@ let close_more tables maxmeta context status auto universe cache = HExtlib.filter_map (fun t -> let ty,_ = - CicTypeChecker.type_of_aux' metasenv context t CicUniv.empty_ugraph in + CicTypeChecker.type_of_aux' metasenv context t + CicUniv.oblivion_ugraph in (* retrieve_equations could also return flexible terms *) if is_an_equality ty then Some(t,ty) else None) equations in @@ -480,12 +608,91 @@ let find_context_equalities indexes, equalities, maxm, cache ;; +(********** PARAMETERS PASSING ***************) + +let bool params name default = + try + let s = List.assoc name params in + if s = "" || s = "1" || s = "true" || s = "yes" || s = "on" then true + else if s = "0" || s = "false" || s = "no" || s= "off" then false + else + let msg = "Unrecognized value for parameter "^name^"\n" in + let msg = msg^"Accepted values are 1,true,yes,on and 0,false,no,off" in + raise (ProofEngineTypes.Fail (lazy msg)) + with Not_found -> default +;; + +let string params name default = + try List.assoc name params with + | Not_found -> default +;; + +let int params name default = + try int_of_string (List.assoc name params) with + | Not_found -> default + | Failure _ -> + raise (ProofEngineTypes.Fail (lazy (name ^ " must be an integer"))) +;; + +let flags_of_params params ?(for_applyS=false) () = + let int = int params in + let bool = bool params in + let close_more = bool "close_more" false in + let use_paramod = bool "use_paramod" true in + let skip_trie_filtering = bool "skip_trie_filtering" false in + let skip_context = bool "skip_context" false in + let use_only_paramod = + if for_applyS then true else bool "paramodulation" false in + let use_library = bool "library" + ((AutoTypes.default_flags()).AutoTypes.use_library) in + let depth = int "depth" ((AutoTypes.default_flags()).AutoTypes.maxdepth) in + let width = int "width" ((AutoTypes.default_flags()).AutoTypes.maxwidth) in + let size = int "size" ((AutoTypes.default_flags()).AutoTypes.maxsize) in + let gsize = int "gsize" ((AutoTypes.default_flags()).AutoTypes.maxgoalsizefactor) in + let do_type = bool "type" false in + let timeout = int "timeout" 0 in + { AutoTypes.maxdepth = + if use_only_paramod then 2 else depth; + AutoTypes.maxwidth = width; + AutoTypes.maxsize = size; + AutoTypes.timeout = + if timeout = 0 then + if for_applyS then Unix.gettimeofday () +. 30.0 + else + infinity + else + Unix.gettimeofday() +. (float_of_int timeout); + AutoTypes.use_library = use_library; + AutoTypes.use_paramod = use_paramod; + AutoTypes.use_only_paramod = use_only_paramod; + AutoTypes.close_more = close_more; + AutoTypes.dont_cache_failures = false; + AutoTypes.maxgoalsizefactor = gsize; + AutoTypes.do_types = do_type; + AutoTypes.skip_trie_filtering = skip_trie_filtering; + AutoTypes.skip_context = skip_context; + } + +let universe_of_params metasenv context universe tl = + if tl = [] then universe else + let tys = + List.map + (fun term -> + fst (CicTypeChecker.type_of_aux' metasenv context term + CicUniv.oblivion_ugraph)) + tl + in + Universe.index_list Universe.empty context (List.combine tl tys) +;; + + (***************** applyS *******************) let new_metasenv_and_unify_and_t dbd flags universe proof goal ?tables newmeta' metasenv' context term' ty termty goal_arity -= += + let ppterm = ppterm context in let (consthead,newmetasenv,arguments,_) = TermUtil.saturate_term newmeta' metasenv' context termty goal_arity in let term'' = @@ -521,20 +728,34 @@ let new_metasenv_and_unify_and_t (PrimitiveTactics.apply_tac term'') (proof''',goal) in - match - let (active, passive,bag), cache, maxmeta = - init_cache_and_tables ~dbd flags.use_library true true false universe + let (active, passive,bag), cache, maxm = + init_cache_and_tables ~dbd flags.use_library false (* was true *) + true false universe (proof'''',newmeta) in - Saturation.given_clause bag maxmeta (proof'''',newmeta) active passive - max_int max_int flags.timeout + match + Saturation.given_clause bag maxm (proof'''',newmeta) active passive + 20 10 flags.timeout with | None, _,_,_ -> raise (ProofEngineTypes.Fail (lazy ("FIXME: propaga le tabelle"))) - | Some (_,proof''''',_), active,passive,_ -> + | Some (_,proof''''',_), active,passive,_ -> proof''''', ProofEngineHelpers.compare_metasenvs ~oldmetasenv ~newmetasenv:(let _,m,_subst,_,_, _ = proof''''' in m), active, passive +(* + debug_print + (lazy + ("SUBSUMPTION SU: " ^ string_of_int newmeta ^ " " ^ ppterm goal_for_paramod)); + let res, maxmeta = + Saturation.all_subsumed bag maxm (proof'''',newmeta) active passive + in + if res = [] then + raise (ProofEngineTypes.Fail (lazy("BUM"))) + else let (_,proof''''',_) = List.hd res in + proof''''',ProofEngineHelpers.compare_metasenvs ~oldmetasenv + ~newmetasenv:(let _,m,_subst,_,_, _ = proof''''' in m), active, passive +*) ;; let rec count_prods context ty = @@ -542,12 +763,16 @@ let rec count_prods context ty = Cic.Prod (n,s,t) -> 1 + count_prods (Some (n,Cic.Decl s)::context) t | _ -> 0 -let apply_smart ~dbd ~term ~subst ~universe ?tables flags (proof, goal) = +let apply_smart + ~dbd ~term ~subst ~universe ?tables ~params:(univ,params) (proof, goal) += let module T = CicTypeChecker in let module R = CicReduction in let module C = Cic in let (_,metasenv,_subst,_,_, _) = proof in let metano,context,ty = CicUtil.lookup_meta goal metasenv in + let flags = flags_of_params params ~for_applyS:true () in + let universe = universe_of_params metasenv context universe univ in let newmeta = CicMkImplicit.new_meta metasenv subst in let exp_named_subst_diff,newmeta',newmetasenvfragment,term' = match term with @@ -583,7 +808,7 @@ let apply_smart ~dbd ~term ~subst ~universe ?tables flags (proof, goal) = in let metasenv' = metasenv@newmetasenvfragment in let termty,_ = - CicTypeChecker.type_of_aux' metasenv' context term' CicUniv.empty_ugraph + CicTypeChecker.type_of_aux' metasenv' context term' CicUniv.oblivion_ugraph in let termty = CicSubstitution.subst_vars exp_named_subst_diff termty in let goal_arity = count_prods context ty in @@ -596,103 +821,7 @@ let apply_smart ~dbd ~term ~subst ~universe ?tables flags (proof, goal) = (****************** AUTO ********************) -let mk_irl ctx = CicMkImplicit.identity_relocation_list_for_metavariable ctx;; -let ugraph = CicUniv.empty_ugraph;; -let typeof = CicTypeChecker.type_of_aux';; -let ppterm ctx t = - let names = List.map (function None -> None | Some (x,_) -> Some x) ctx in - CicPp.pp t names -;; -let is_in_prop context subst metasenv ty = - let sort,u = typeof ~subst metasenv context ty CicUniv.empty_ugraph in - fst (CicReduction.are_convertible context sort (Cic.Sort Cic.Prop) u) -;; - -let assert_proof_is_valid proof metasenv context goalty = - if debug then - begin - let ty,u = typeof metasenv context proof CicUniv.empty_ugraph in - let b,_ = CicReduction.are_convertible context ty goalty u in - if not b then - begin - let names = - List.map (function None -> None | Some (x,_) -> Some x) context - in - debug_print (lazy ("PROOF:" ^ CicPp.pp proof names)); - debug_print (lazy ("PROOFTY:" ^ CicPp.pp ty names)); - debug_print (lazy ("GOAL:" ^ CicPp.pp goalty names)); - debug_print (lazy ("MENV:" ^ CicMetaSubst.ppmetasenv [] metasenv)); - end; - assert b - end - else () -;; -let assert_subst_are_disjoint subst subst' = - if debug then - assert(List.for_all - (fun (i,_) -> List.for_all (fun (j,_) -> i<>j) subst') - subst) - else () -;; - -let split_goals_in_prop metasenv subst gl = - List.partition - (fun g -> - let _,context,ty = CicUtil.lookup_meta g metasenv in - try - let sort,u = typeof ~subst metasenv context ty ugraph in - let b,_ = - CicReduction.are_convertible - ~subst ~metasenv context sort (Cic.Sort Cic.Prop) u in - b - with - | CicTypeChecker.AssertFailure s - | CicTypeChecker.TypeCheckerFailure s -> - debug_print - (lazy ("NON TIPA" ^ ppterm context (CicMetaSubst.apply_subst subst ty))); - debug_print s; - false) - (* FIXME... they should type! *) - gl -;; - -let split_goals_with_metas metasenv subst gl = - List.partition - (fun g -> - let _,context,ty = CicUtil.lookup_meta g metasenv in - let ty = CicMetaSubst.apply_subst subst ty in - CicUtil.is_meta_closed ty) - gl -;; - -let order_new_goals metasenv subst open_goals ppterm = - let prop,rest = split_goals_in_prop metasenv subst open_goals in - let closed_prop, open_prop = split_goals_with_metas metasenv subst prop in - let open_goals = - (List.map (fun x -> x,P) (closed_prop @ open_prop)) - @ - (List.map (fun x -> x,T) rest) - in - let tys = - List.map - (fun (i,sort) -> - let _,_,ty = CicUtil.lookup_meta i metasenv in i,ty,sort) open_goals - in - debug_print (lazy (" OPEN: "^ - String.concat "\n" - (List.map - (function - | (i,t,P) -> string_of_int i ^ ":"^ppterm t^ "Prop" - | (i,t,T) -> string_of_int i ^ ":"^ppterm t^ "Type") - tys))); - open_goals -;; - -let is_an_equational_goal = function - | Cic.Appl [Cic.MutInd(u,_,_);_;_;_] when LibraryObjects.is_eq_URI u -> true - | _ -> false -;; (* let prop = function (_,depth,P) -> depth < 9 | _ -> false;; @@ -728,7 +857,7 @@ type menv = Cic.metasenv type subst = Cic.substitution type goal = ProofEngineTypes.goal * int * AutoTypes.sort let candidate_no = ref 0;; -type candidate = int * Cic.term +type candidate = int * Cic.term Lazy.t type cache = AutoCache.cache type tables = Saturation.active_table * Saturation.passive_table * Equality.equality_bag @@ -758,8 +887,8 @@ type auto_result = (* the status exported to the external observer *) type auto_status = (* context, (goal,candidate) list, and_list, history *) - Cic.context * (int * Cic.term * bool * int * (int * Cic.term) list) list * - (int * Cic.term * int) list * Cic.term list + Cic.context * (int * Cic.term * bool * int * (int * Cic.term Lazy.t) list) list * + (int * Cic.term * int) list * Cic.term Lazy.t list let d_prefix l = let rec aux acc = function @@ -780,6 +909,7 @@ let d_goals l = in aux [] l ;; + let calculate_goal_ty (goalno,_,_) s m = try let _,cc,goalty = CicUtil.lookup_meta goalno m in @@ -787,6 +917,7 @@ let calculate_goal_ty (goalno,_,_) s m = Some (cc, CicMetaSubst.apply_subst s goalty) with CicUtil.Meta_not_found i when i = goalno -> None ;; + let calculate_closed_goal_ty (goalno,_,_) s = try let cc,_,goalty = List.assoc goalno s in @@ -794,6 +925,7 @@ let calculate_closed_goal_ty (goalno,_,_) s = Some (cc, CicMetaSubst.apply_subst s goalty) with Not_found -> None ;; + let pp_status ctx status = if debug then let names = Utils.names_of_context ctx in @@ -811,7 +943,7 @@ let pp_status ctx status = | None -> Printf.sprintf "D(%d, _, %d)" gi d in let string_of_s m su k (ci,ct) gi = - Printf.sprintf "S(%d, %s, %s, %d)" gi (pp k) (pp ct) ci + Printf.sprintf "S(%d, %s, %s, %d)" gi (pp k) (pp (Lazy.force ct)) ci in let string_of_ol m su l = String.concat " | " @@ -949,6 +1081,15 @@ let list_union l1 l2 = (* TODO ottimizzare compare *) HExtlib.list_uniq (List.sort compare (l1 @ l1)) ;; +let rec eq_todo l1 l2 = + match l1,l2 with + | (D g1) :: tl1,(D g2) :: tl2 when g1=g2 -> eq_todo tl1 tl2 + | (S (g1,k1,(c1,lt1),i1)) :: tl1, (S (g2,k2,(c2,lt2),i2)) :: tl2 + when i1 = i2 && g1 = g2 && k1 = k2 && c1 = c2 -> + if Lazy.force lt1 = Lazy.force lt2 then eq_todo tl1 tl2 else false + | [],[] -> true + | _ -> false +;; let eat_head todo id fl orlist = let rec aux acc = function | [] -> [], acc @@ -958,7 +1099,7 @@ let eat_head todo id fl orlist = | None -> orlist, acc | Some (((gno,_,_),_,_,_), todo11) -> (* TODO confronto tra todo da ottimizzare *) - if gno = id && todo11 = todo then + if gno = id && eq_todo todo11 todo then aux (list_union fl1 acc) tl else aux1 todo11 @@ -1046,11 +1187,14 @@ let put_in_subst subst metasenv (goalno,_,_) canonical_ctx t ty = let entry = goalno, (canonical_ctx, t,ty) in assert_subst_are_disjoint subst [entry]; let subst = entry :: subst in + let metasenv = CicMetaSubst.apply_subst_metasenv subst metasenv in + subst, metasenv ;; + let mk_fake_proof metasenv subst (goalno,_,_) goalty context = - None,metasenv,subst ,Cic.Meta(goalno,mk_irl context),goalty, [] + None,metasenv,subst ,(lazy (Cic.Meta(goalno,mk_irl context))),goalty, [] ;; let equational_case tables maxm cache depth fake_proof goalno goalty subst context @@ -1066,6 +1210,7 @@ let equational_case let goal_steps, saturation_steps, timeout = max_int,max_int,flags.timeout in + match Saturation.given_clause bag maxm status active passive goal_steps saturation_steps timeout @@ -1129,7 +1274,7 @@ let try_candidate let open_goals = order_new_goals metasenv subst open_goals ppterm in let open_goals = List.map (fun (x,sort) -> x,depth-1,sort) open_goals in incr candidate_no; - Some ((!candidate_no,cand),metasenv,subst,open_goals), tables , maxmeta + Some ((!candidate_no,lazy cand),metasenv,subst,open_goals), tables , maxmeta with | ProofEngineTypes.Fail s -> None,tables, maxm | CicUnification.Uncertain s -> None,tables, maxm @@ -1142,9 +1287,9 @@ let sort_new_elems = let applicative_case tables maxm depth subst fake_proof goalno goalty metasenv context universe - cache + cache flags = - let candidates = get_candidates universe cache goalty in + let candidates = get_candidates flags.skip_trie_filtering universe cache goalty in let tables, elems, maxm = List.fold_left (fun (tables,elems,maxm) cand -> @@ -1177,14 +1322,14 @@ let equational_and_applicative_case else applicative_case tables maxm depth s fake_proof goalno - gty m context universe cache + gty m context universe cache flags in let maxm = maxm1 in elems@more_elems, tables, cache, maxm, flags else let elems, tables, cache, maxm = applicative_case tables maxm depth s fake_proof goalno - gty m context universe cache + gty m context universe cache flags in elems, tables, cache, maxm, flags ;; @@ -1209,7 +1354,7 @@ let prunable_for_size flags s m todo = | (D g)::tl -> (match calculate_goal_ty g s m with | None -> aux b tl - | Some (canonical_ctx, gty) -> + | Some (canonical_ctx, gty) -> let gsize, _ = Utils.weight_of_term ~consider_metas:false ~count_metas_occurrences:true gty in @@ -1249,8 +1394,18 @@ let prunable menv subst ty todo = (match calculate_goal_ty g variant menv with | None -> assert false | Some (_, gty') -> - if gty = gty' then - no_progress variant tl + if gty = gty' then no_progress variant tl +(* +(prerr_endline (string_of_int n); + prerr_endline (CicPp.ppterm gty); + prerr_endline (CicPp.ppterm gty'); + prerr_endline "---------- subst"; + prerr_endline (CicMetaSubst.ppsubst ~metasenv:menv subst); + prerr_endline "---------- variant"; + prerr_endline (CicMetaSubst.ppsubst ~metasenv:menv variant); + prerr_endline "---------- menv"; + prerr_endline (CicMetaSubst.ppmetasenv [] menv); + no_progress variant tl) *) else false)) | _::tl -> no_progress variant tl in @@ -1280,6 +1435,7 @@ let auto_main tables maxm context flags universe cache elems = let elems = filter_prune_hint elems in match elems with | (m, s, size, don, todo, fl)::orlist when !hint <> None -> + debug_print (lazy "skip"); (match !hint with | Some i when condition_for_hint i todo -> aux tables maxm flags cache orlist @@ -1288,13 +1444,16 @@ let auto_main tables maxm context flags universe cache elems = aux tables maxm flags cache elems) | [] -> (* complete failure *) + debug_print (lazy "give up"); Gaveup (tables, cache, maxm) | (m, s, _, _, [],_)::orlist -> (* complete success *) + debug_print (lazy "success"); Proved (m, s, orlist, tables, cache, maxm) | (m, s, size, don, (D (_,_,T))::todo, fl)::orlist when not flags.AutoTypes.do_types -> (* skip since not Prop, don't even check if closed by side-effect *) + debug_print (lazy "skip existential goal"); aux tables maxm flags cache ((m, s, size, don, todo, fl)::orlist) | (m, s, size, don, (S(g, key, c,minsize) as op)::todo, fl)::orlist -> (* partial success, cache g and go on *) @@ -1324,13 +1483,14 @@ let auto_main tables maxm context flags universe cache elems = debug_print (lazy ("FAIL: TIMEOUT")); Gaveup (tables, cache, maxm) | (m, s, size, don, (D (gno,depth,_ as g))::todo, fl)::orlist as status -> - (* attack g *) + (* attack g *) + debug_print (lazy "attack goal"); match calculate_goal_ty g s m with | None -> (* closed by side effect *) debug_print (lazy ("SUCCESS: SIDE EFFECT: " ^ string_of_int gno)); aux tables maxm flags cache ((m,s,size,don,todo, fl)::orlist) - | Some (canonical_ctx, gty) -> + | Some (canonical_ctx, gty) -> let gsize, _ = Utils.weight_of_term ~consider_metas:false ~count_metas_occurrences:true gty in @@ -1457,7 +1617,7 @@ let solutions,cache,maxm ;; -(* }}} ****************** AUTO ***************) +(******************* AUTO ***************) let auto flags metasenv tables universe cache context metasenv gl = let initial_time = Unix.gettimeofday() in @@ -1475,72 +1635,12 @@ let auto flags metasenv tables universe cache context metasenv gl = None,cache ;; -let bool params name default = - try - let s = List.assoc name params in - if s = "" || s = "1" || s = "true" || s = "yes" || s = "on" then true - else if s = "0" || s = "false" || s = "no" || s= "off" then false - else - let msg = "Unrecognized value for parameter "^name^"\n" in - let msg = msg^"Accepted values are 1,true,yes,on and 0,false,no,off" in - raise (ProofEngineTypes.Fail (lazy msg)) - with Not_found -> default -;; - -let string params name default = - try List.assoc name params with - | Not_found -> default -;; - -let int params name default = - try int_of_string (List.assoc name params) with - | Not_found -> default - | Failure _ -> - raise (ProofEngineTypes.Fail (lazy (name ^ " must be an integer"))) -;; - -let flags_of_params params ?(for_applyS=false) () = - let int = int params in - let bool = bool params in - let close_more = bool "close_more" false in - let use_paramod = bool "use_paramod" true in - let use_only_paramod = - if for_applyS then true else bool "paramodulation" false in - let use_library = bool "library" - ((AutoTypes.default_flags()).AutoTypes.use_library) in - let depth = int "depth" ((AutoTypes.default_flags()).AutoTypes.maxdepth) in - let width = int "width" ((AutoTypes.default_flags()).AutoTypes.maxwidth) in - let size = int "size" ((AutoTypes.default_flags()).AutoTypes.maxsize) in - let gsize = int "gsize" ((AutoTypes.default_flags()).AutoTypes.maxgoalsizefactor) in - let do_type = bool "type" false in - let timeout = int "timeout" 0 in - { AutoTypes.maxdepth = - if use_only_paramod then 2 else depth; - AutoTypes.maxwidth = width; - AutoTypes.maxsize = size; - AutoTypes.timeout = - if timeout = 0 then - if for_applyS then Unix.gettimeofday () +. 30.0 - else - infinity - else - Unix.gettimeofday() +. (float_of_int timeout); - AutoTypes.use_library = use_library; - AutoTypes.use_paramod = use_paramod; - AutoTypes.use_only_paramod = use_only_paramod; - AutoTypes.close_more = close_more; - AutoTypes.dont_cache_failures = false; - AutoTypes.maxgoalsizefactor = gsize; - AutoTypes.do_types = do_type; - } - let applyS_tac ~dbd ~term ~params ~universe = ProofEngineTypes.mk_tactic (fun status -> try let proof, gl,_,_ = - apply_smart ~dbd ~term ~subst:[] ~universe - (flags_of_params params ~for_applyS:true ()) status + apply_smart ~dbd ~term ~subst:[] ~params ~universe status in proof, gl with @@ -1548,185 +1648,45 @@ let applyS_tac ~dbd ~term ~params ~universe = | CicTypeChecker.TypeCheckerFailure msg -> raise (ProofEngineTypes.Fail msg)) -(* SUPERPOSITION *) - -(* Syntax: - * auto superposition target = NAME - * [table = NAME_LIST] [demod_table = NAME_LIST] [subterms_only] - * - * - if table is omitted no superposition will be performed - * - if demod_table is omitted no demodulation will be prformed - * - subterms_only is passed to Indexing.superposition_right - * - * lists are coded using _ (example: H_H1_H2) - *) - -let eq_and_ty_of_goal = function - | Cic.Appl [Cic.MutInd(uri,0,_);t;_;_] when LibraryObjects.is_eq_URI uri -> - uri,t - | _ -> raise (ProofEngineTypes.Fail (lazy ("The goal is not an equality "))) -;; - -let rec find_in_ctx i name = function - | [] -> raise (ProofEngineTypes.Fail (lazy ("Hypothesis not found: " ^ name))) - | Some (Cic.Name name', _)::tl when name = name' -> i - | _::tl -> find_in_ctx (i+1) name tl -;; - -let rec position_of i x = function - | [] -> assert false - | j::tl when j <> x -> position_of (i+1) x tl - | _ -> i -;; - - -let superposition_tac ~target ~table ~subterms_only ~demod_table status = - Saturation.reset_refs(); - let proof,goalno = status in - let curi,metasenv,_subst,pbo,pty, attrs = proof in - let metano,context,ty = CicUtil.lookup_meta goalno metasenv in - let eq_uri,tty = eq_and_ty_of_goal ty in - let env = (metasenv, context, CicUniv.empty_ugraph) in - let names = Utils.names_of_context context in - let bag = Equality.mk_equality_bag () in - let eq_index, equalities, maxm,cache = - find_context_equalities 0 bag context proof Universe.empty AutoCache.cache_empty - in - let eq_what = - let what = find_in_ctx 1 target context in - List.nth equalities (position_of 0 what eq_index) - in - let eq_other = - if table <> "" then - let other = - let others = Str.split (Str.regexp "_") table in - List.map (fun other -> find_in_ctx 1 other context) others - in - List.map - (fun other -> List.nth equalities (position_of 0 other eq_index)) - other - else - [] - in - let index = List.fold_left Indexing.index Indexing.empty eq_other in - let maxm, eql = - if table = "" then maxm,[eq_what] else - Indexing.superposition_right bag - ~subterms_only eq_uri maxm env index eq_what +let auto_tac ~(dbd:HSql.dbd) ~params:(univ,params) ~universe (proof, goal) = + let _,metasenv,_subst,_,_, _ = proof in + let _,context,goalty = CicUtil.lookup_meta goal metasenv in + let flags = flags_of_params params () in + let universe = universe_of_params metasenv context universe univ in + let use_library = flags.use_library in + let tables,cache,newmeta = + init_cache_and_tables ~dbd use_library flags.use_only_paramod (not flags.skip_context) + false universe (proof, goal) in + let tables,cache,newmeta = + if flags.close_more then + close_more + tables newmeta context (proof, goal) + auto_all_solutions universe cache + else tables,cache,newmeta in + let initial_time = Unix.gettimeofday() in + let (_,oldmetasenv,_subst,_,_, _) = proof in + hint := None; + let elem = + metasenv,[],1,[],[D (goal,flags.maxdepth,P)],[] in - debug_print (lazy ("Superposition right:")); - debug_print (lazy ("\n eq: " ^ Equality.string_of_equality eq_what ~env)); - debug_print (lazy ("\n table: ")); - List.iter - (fun e -> - debug_print (lazy (" " ^ Equality.string_of_equality e ~env))) eq_other; - debug_print (lazy ("\n result: ")); - List.iter (fun e -> debug_print (lazy (Equality.string_of_equality e ~env))) eql; - debug_print (lazy ("\n result (cut&paste): ")); - List.iter - (fun e -> - let t = Equality.term_of_equality eq_uri e in - debug_print (lazy (CicPp.pp t names))) - eql; - debug_print (lazy ("\n result proofs: ")); - List.iter (fun e -> - debug_print (lazy (let _,p,_,_,_ = Equality.open_equality e in - let s = match p with Equality.Exact _ -> Subst.empty_subst | Equality.Step (s,_) -> s in - Subst.ppsubst s ^ "\n" ^ - CicPp.pp (Equality.build_proof_term bag eq_uri [] 0 p) names))) eql; - if demod_table <> "" then - begin - let eql = - if eql = [] then [eq_what] else eql - in - let demod = - let demod = Str.split (Str.regexp "_") demod_table in - List.map (fun other -> find_in_ctx 1 other context) demod - in - let eq_demod = - List.map - (fun demod -> List.nth equalities (position_of 0 demod eq_index)) - demod - in - let table = List.fold_left Indexing.index Indexing.empty eq_demod in - let maxm,eql = - List.fold_left - (fun (maxm,acc) e -> - let maxm,eq = - Indexing.demodulation_equality bag eq_uri maxm env table e - in - maxm,eq::acc) - (maxm,[]) eql - in - let eql = List.rev eql in - debug_print (lazy ("\n result [demod]: ")); - List.iter - (fun e -> debug_print (lazy (Equality.string_of_equality e ~env))) eql; - debug_print (lazy ("\n result [demod] (cut&paste): ")); - List.iter - (fun e -> - let t = Equality.term_of_equality eq_uri e in - debug_print (lazy (CicPp.pp t names))) - eql; - end; - proof,[goalno] -;; - -let auto_tac ~(dbd:HSql.dbd) ~params ~universe (proof, goal) = - (* argument parsing *) - let string = string params in - let bool = bool params in - (* hacks to debug paramod *) - let superposition = bool "superposition" false in - let target = string "target" "" in - let table = string "table" "" in - let subterms_only = bool "subterms_only" false in - let demod_table = string "demod_table" "" in - match superposition with - | true -> - (* this is the ugly hack to debug paramod *) - superposition_tac - ~target ~table ~subterms_only ~demod_table (proof,goal) - | false -> - (* this is the real auto *) - let _,metasenv,_subst,_,_, _ = proof in - let _,context,goalty = CicUtil.lookup_meta goal metasenv in - let flags = flags_of_params params () in - (* just for testing *) - let use_library = flags.use_library in - let tables,cache,newmeta = - init_cache_and_tables ~dbd use_library flags.use_only_paramod true - false universe (proof, goal) in - let tables,cache,newmeta = - if flags.close_more then - close_more - tables newmeta context (proof, goal) - auto_all_solutions universe cache - else tables,cache,newmeta in - let initial_time = Unix.gettimeofday() in - let (_,oldmetasenv,_subst,_,_, _) = proof in - hint := None; - let elem = - metasenv,[],1,[],[D (goal,flags.maxdepth,P)],[] - in - match auto_main tables newmeta context flags universe cache [elem] with - | Proved (metasenv,subst,_, tables,cache,_) -> - (*prerr_endline - ("TIME:"^string_of_float(Unix.gettimeofday()-.initial_time));*) - let proof,metasenv = - ProofEngineHelpers.subst_meta_and_metasenv_in_proof - proof goal subst metasenv - in - let opened = - ProofEngineHelpers.compare_metasenvs ~oldmetasenv - ~newmetasenv:metasenv - in - proof,opened - | Gaveup (tables,cache,maxm) -> - debug_print - (lazy ("TIME:"^ - string_of_float(Unix.gettimeofday()-.initial_time))); - raise (ProofEngineTypes.Fail (lazy "Auto gave up")) + match auto_main tables newmeta context flags universe cache [elem] with + | Proved (metasenv,subst,_, tables,cache,_) -> + debug_print (lazy + ("TIME:"^string_of_float(Unix.gettimeofday()-.initial_time))); + let proof,metasenv = + ProofEngineHelpers.subst_meta_and_metasenv_in_proof + proof goal subst metasenv + in + let opened = + ProofEngineHelpers.compare_metasenvs ~oldmetasenv + ~newmetasenv:metasenv + in + proof,opened + | Gaveup (tables,cache,maxm) -> + debug_print + (lazy ("TIME:"^ + string_of_float(Unix.gettimeofday()-.initial_time))); + raise (ProofEngineTypes.Fail (lazy "Auto gave up")) ;; let auto_tac ~dbd ~params ~universe = @@ -1740,9 +1700,11 @@ let eq_of_goal = function (* performs steps of rewrite with the universe, obtaining if possible * a trivial goal *) -let solve_rewrite_tac ~universe ?(steps=1) (proof,goal as status)= +let solve_rewrite_tac ~universe ~params:(univ,params) (proof,goal as status)= let _,metasenv,_subst,_,_,_ = proof in let _,context,ty = CicUtil.lookup_meta goal metasenv in + let steps = int_of_string (string params "steps" "1") in + let universe = universe_of_params metasenv context universe univ in let eq_uri = eq_of_goal ty in let (active,passive,bag), cache, maxm = (* we take the whole universe (no signature filtering) *) @@ -1754,7 +1716,7 @@ let solve_rewrite_tac ~universe ?(steps=1) (proof,goal as status)= (* we demodulate using both actives passives *) List.fold_left (fun tbl eq -> Indexing.index tbl eq) (snd active) equalities in - let env = metasenv,context,CicUniv.empty_ugraph in + let env = metasenv,context,CicUniv.oblivion_ugraph in match Indexing.solve_demodulating bag env table initgoal steps with | Some (proof, metasenv, newty) -> let refl = @@ -1774,37 +1736,185 @@ let solve_rewrite_tac ~universe ?(steps=1) (proof,goal as status)= (ProofEngineTypes.Fail (lazy ("Unable to solve with " ^ string_of_int steps ^ " demodulations"))) ;; -let solve_rewrite_tac ~universe ?steps () = - ProofEngineTypes.mk_tactic (solve_rewrite_tac ~universe ?steps) +let solve_rewrite_tac ~params ~universe () = + ProofEngineTypes.mk_tactic (solve_rewrite_tac ~universe ~params) ;; -(* DEMODULATE *) -let demodulate_tac ~dbd ~universe (proof,goal)= +(* Demodulate thorem *) +let open_type ty bo = + let rec open_type_aux context ty k args = + match ty with + | Cic.Prod (n,s,t) -> + let n' = + FreshNamesGenerator.mk_fresh_name [] context n ~typ:s ~subst:[] in + let entry = match n' with + | Cic.Name _ -> Some (n',(Cic.Decl s)) + | Cic.Anonymous -> None + in + open_type_aux (entry::context) t (k+1) ((Cic.Rel k)::args) + | Cic.LetIn (n,s,sty,t) -> + let entry = Some (n,(Cic.Def (s,sty))) + in + open_type_aux (entry::context) t (k+1) args + | _ -> context, ty, args + in + let context, ty, args = open_type_aux [] ty 1 [] in + match args with + | [] -> context, ty, bo + | _ -> context, ty, Cic.Appl (bo::args) +;; + +let rec close_type bo ty context = + match context with + | [] -> assert_proof_is_valid bo [] [] ty; (bo,ty) + | Some (n,(Cic.Decl s))::tl -> + close_type (Cic.Lambda (n,s,bo)) (Cic.Prod (n,s,ty)) tl + | Some (n,(Cic.Def (s,sty)))::tl -> + close_type (Cic.LetIn (n,s,sty,bo)) (Cic.LetIn (n,s,sty,ty)) tl + | _ -> assert false +;; + +let is_subsumed univ context ty = + let candidates = Universe.get_candidates univ ty in + List.fold_left + (fun res cand -> + match res with + | Some found -> Some found + | None -> + try + let mk_irl = CicMkImplicit.identity_relocation_list_for_metavariable in + let metasenv = [(0,context,ty)] in + let fake_proof = None,metasenv,[] , (lazy (Cic.Meta(0,mk_irl context))),ty,[] in + let subst,((_,metasenv,_,_,_,_), open_goals),maxmeta = + (PrimitiveTactics.apply_with_subst ~subst:[] ~maxmeta:0 ~term:cand) (fake_proof,0) + in + let prop_goals, other = split_goals_in_prop metasenv subst open_goals in + if prop_goals = [] then Some cand else None + with + | ProofEngineTypes.Fail s -> None + | CicUnification.Uncertain s -> None + ) None candidates +;; + +let demodulate_theorem ~universe uri = + let eq_uri = + match LibraryObjects.eq_URI () with + | Some (uri) -> uri + | None -> raise (ProofEngineTypes.Fail (lazy "equality not declared")) in + let obj,_ = CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri + in + let context,ty,bo = + match obj with + | Cic.Constant(n, _, ty ,_, _) -> open_type ty (Cic.Const(uri,[])) + | _ -> raise (ProofEngineTypes.Fail (lazy "not a theorem")) + in + if CicUtil.is_closed ty then + raise (ProofEngineTypes.Fail (lazy ("closed term: dangerous reduction"))); + let initgoal = [], [], ty in + (* compute the signature *) + let signature = + let ty_set = MetadataConstraints.constants_of ty in + let hyp_set = MetadataQuery.signature_of_hypothesis context [] in + let set = MetadataConstraints.UriManagerSet.union ty_set hyp_set in + MetadataQuery.close_with_types set [] context + in + (* retrieve equations from the universe universe *) + let equations = + retrieve_equations true signature universe AutoCache.cache_empty context [] + in + debug_print + (lazy ("ho trovato equazioni n. "^(string_of_int (List.length equations)))); + let eqs_and_types = + HExtlib.filter_map + (fun t -> + let ty,_ = + CicTypeChecker.type_of_aux' [] context t CicUniv.oblivion_ugraph + in + (* retrieve_equations could also return flexible terms *) + if is_an_equality ty then Some(t,ty) + else + try + let ty' = unfold context ty in + if is_an_equality ty' then Some(t,ty') else None + with ProofEngineTypes.Fail _ -> None) + equations + in + let bag = Equality.mk_equality_bag () in + + let units, _, newmeta = + partition_unit_equalities context [] (CicMkImplicit.new_meta [] []) bag eqs_and_types + in + let table = + List.fold_left + (fun tbl eq -> Indexing.index tbl eq) + Indexing.empty units + in + let changed,(newproof,newmetasenv, newty) = + Indexing.demod bag + ([],context,CicUniv.oblivion_ugraph) table initgoal in + if changed then + begin + let oldproof = Equality.Exact bo in + let proofterm,_ = + Equality.build_goal_proof (~contextualize:false) (~forward:true) bag + eq_uri newproof oldproof ty [] context newmetasenv + in + if newmetasenv <> [] then + raise (ProofEngineTypes.Fail (lazy ("metasenv not empty"))) + else + begin + assert_proof_is_valid proofterm newmetasenv context newty; + match is_subsumed universe context newty with + | Some t -> raise + (ProofEngineTypes.Fail (lazy ("subsumed by " ^ CicPp.ppterm t))) + | None -> close_type proofterm newty context + end + end + else (* if newty = ty then *) + raise (ProofEngineTypes.Fail (lazy "no progress")) + (*else ProofEngineTypes.apply_tactic + (ReductionTactics.simpl_tac + ~pattern:(ProofEngineTypes.conclusion_pattern None)) initialstatus*) +;; + + +(* NEW DEMODULATE *) +let demodulate_tac ~dbd ~universe ~params:(univ, params) (proof,goal)= let curi,metasenv,_subst,pbo,pty, attrs = proof in let metano,context,ty = CicUtil.lookup_meta goal metasenv in + let universe = universe_of_params metasenv context universe univ in let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in let initgoal = [], metasenv, ty in - let eq_uri = eq_of_goal ty in + let eq_uri = + match LibraryObjects.eq_URI () with + | Some (uri) -> uri + | None -> raise (ProofEngineTypes.Fail (lazy "equality not declared")) in + (* let eq_uri = eq_of_goal ty in *) let (active,passive,bag), cache, maxm = init_cache_and_tables - ~dbd false true true false universe (proof,goal) + ~dbd false false true true universe (proof,goal) in let equalities = (Saturation.list_of_passive passive) in (* we demodulate using both actives passives *) + let env = metasenv,context,CicUniv.empty_ugraph in + debug_print (lazy ("PASSIVES:" ^ string_of_int(List.length equalities))); + List.iter (fun e -> debug_print (lazy (Equality.string_of_equality ~env e))) + equalities; let table = List.fold_left (fun tbl eq -> Indexing.index tbl eq) (snd active) equalities in - let changed,(newproof,newmetasenv, newty) = - Indexing.demodulation_goal bag - (metasenv,context,CicUniv.empty_ugraph) table initgoal + let changed,(newproof,newmetasenv, newty) = + (* Indexing.demodulation_goal bag *) + Indexing.demod bag + (metasenv,context,CicUniv.oblivion_ugraph) table initgoal in if changed then begin let opengoal = Equality.Exact (Cic.Meta(maxm,irl)) in let proofterm,_ = - Equality.build_goal_proof bag + Equality.build_goal_proof (~contextualize:false) bag eq_uri newproof opengoal ty [] context metasenv in let extended_metasenv = (maxm,context,newty)::metasenv in @@ -1823,8 +1933,8 @@ let demodulate_tac ~dbd ~universe (proof,goal)= ~pattern:(ProofEngineTypes.conclusion_pattern None)) initialstatus*) ;; -let demodulate_tac ~dbd ~universe = - ProofEngineTypes.mk_tactic (demodulate_tac ~dbd ~universe);; +let demodulate_tac ~dbd ~params ~universe = + ProofEngineTypes.mk_tactic (demodulate_tac ~dbd ~params ~universe);; let pp_proofterm = Equality.pp_proofterm;;