new internal flags for auto:

[helm.git] / helm / software / components / tactics / auto.ml

diff --git a/helm/software/components/tactics/auto.ml b/helm/software/components/tactics/auto.ml
index e8131d9802a6227426e5cc7b95316eeaf6c2a2ee..07331220cbdcadee037d4a1459c80eb759970e0b 100644 (file)
--- a/helm/software/components/tactics/auto.ml
+++ b/helm/software/components/tactics/auto.ml
@@ -26,10 +26,11 @@
 open AutoTypes;;
 open AutoCache;;
 
-let debug = true;;
+let debug = false;;
 let debug_print s = 
   if debug then prerr_endline (Lazy.force s);;
 
+
 let is_propositional context sort = 
   match CicReduction.whd context sort with
   | Cic.Sort Cic.Prop 
@@ -162,7 +163,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 
@@ -203,7 +205,7 @@ 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
@@ -524,6 +526,8 @@ let flags_of_params params ?(for_applyS=false) () =
  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"  
@@ -552,6 +556,8 @@ let flags_of_params params ?(for_applyS=false) () =
     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 =
@@ -613,15 +619,12 @@ let new_metasenv_and_unify_and_t
      init_cache_and_tables ~dbd flags.use_library true true false universe
      (proof'''',newmeta)
    in
-     prerr_endline "chiamo given clause";
      Saturation.given_clause bag maxmeta (proof'''',newmeta) active passive 
        max_int max_int flags.timeout
  with
  | None, _,_,_ -> 
      raise (ProofEngineTypes.Fail (lazy ("FIXME: propaga le tabelle"))) 
  | Some (_,proof''''',_), active,passive,_  -> 
-     prerr_endline "torno";
-
      proof''''',
      ProofEngineHelpers.compare_metasenvs ~oldmetasenv
        ~newmetasenv:(let _,m,_subst,_,_, _ = proof''''' in m),  active, passive
@@ -1254,9 +1257,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 ->
@@ -1289,14 +1292,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  
 ;;
@@ -1608,11 +1611,11 @@ let applyS_tac ~dbd ~term ~params ~universe =
 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 universe = universe_of_params metasenv context universe univ 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 true 
+    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
@@ -1741,7 +1744,7 @@ let is_subsumed univ context ty =
               try 
                  let mk_irl = CicMkImplicit.identity_relocation_list_for_metavariable in
                 let metasenv = [(0,context,ty)] in
-                let fake_proof = None,metasenv,[] ,Cic.Meta(0,mk_irl 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