]> matita.cs.unibo.it Git - helm.git/commitdiff
some work for auto
authorEnrico Tassi <enrico.tassi@inria.fr>
Fri, 16 Oct 2009 12:40:16 +0000 (12:40 +0000)
committerEnrico Tassi <enrico.tassi@inria.fr>
Fri, 16 Oct 2009 12:40:16 +0000 (12:40 +0000)
helm/software/components/ng_tactics/nAuto.ml
helm/software/components/ng_tactics/nAuto.mli
helm/software/components/ng_tactics/nTacStatus.ml
helm/software/components/ng_tactics/nTacStatus.mli

index 4193d41da75b58035ca3c5c0565a645f8e9eae51..a80334d01d6cc24155e51e54f51daee5a6fc69de 100644 (file)
@@ -13,8 +13,8 @@
 
 open Printf
 
-let debug = true
-let debug_print s = if debug then prerr_endline (Lazy.force s) else ()
+let debug = ref false
+let debug_print s = if !debug then prerr_endline (Lazy.force s) else ()
 
 open Continuationals.Stack
 open NTacStatus
@@ -925,9 +925,19 @@ let mk_th_cache status gl =
          let status,_,idx = 
            List.fold_left (fun (status, i, idx) _ -> 
               let t = mk_cic_term ctx (NCic.Rel i) in
-              let status, ty = typeof status ctx t in
-              let _, ty, _ = saturate status ty in
+              let status, orig_ty = typeof status ctx t in
+              let _, ty, _ = saturate ~delta:max_int status orig_ty in
               let idx = InvRelDiscriminationTree.index idx ty t in
+              let idx = 
+                let _, ty = term_of_cic_term status ty (ctx_of ty) in
+                match ty with
+                | NCic.Const (NReference.Ref (_,NReference.Def h)) 
+                | NCic.Appl (NCic.Const(NReference.Ref(_,NReference.Def h))::_) 
+                   when h > 0 ->
+                     let _,ty,_= saturate status ~delta:(h-1) orig_ty in
+                     InvRelDiscriminationTree.index idx ty t
+                | _ -> idx
+              in
               status, i+1, idx)
              (status, 1, idx) ctx
           in
@@ -1025,11 +1035,14 @@ let put_in_subst s _ _ _  = s;;
 let add_to_cache_and_del_from_orlist_if_green_cut _ _ c _ _ o f _ = c, o, f, false ;; 
 let cache_add_underinspection c _ _ = c;;
 let equational_case _ _ _ _ _ _ = [];;
-let sort_new_elems l = l;;
 let only _ _ _ = true;;
 
 let candidate_no = ref 0;;
 
+let sort_new_elems l = 
+  List.sort (fun (_,_,l1) (_,_,l2) -> List.length l1 - List.length l2) l
+;;
+
 let try_candidate status t g =
  try
    debug_print (lazy (" try " ^ CicNotationPp.pp_term t));
index 7121bb946294e5e6b3759a62b3cd62de99dcac83..99d6aa7e8cc44d1aed184cedbcca557c8c81c7f3 100644 (file)
@@ -15,3 +15,4 @@ val auto_tac:
   params:(NTacStatus.tactic_term list * (string * string) list) -> 
    's NTacStatus.tactic
 
+val debug : bool ref
index 8d47439c04ea163336f1e0df709a650c6f4d8353..f51f4d2d79b7f06c013de46310a37e882122fafd 100644 (file)
@@ -162,13 +162,13 @@ let typeof status ctx t =
 ;;
 let typeof a b c = wrap "typeof" (typeof a b) c;;
 
-let saturate status (ctx,t) =
+let saturate status ?delta (ctx,t) =
   let n,h,metasenv,subst,k = status#obj in
-  let t, metasenv, args = NCicMetaSubst.saturate metasenv subst ctx t 0 in
+  let t,metasenv,args = NCicMetaSubst.saturate ?delta metasenv subst ctx t 0 in
   let status = status#set_obj (n,h,metasenv,subst,k) in
   status, (ctx,t), List.map (fun x -> ctx,x) args
 ;;
-let saturate a b = wrap "saturate" (saturate a) b;;
+let saturate a ?delta b = wrap "saturate" (saturate a ?delta) b;;
   
 let whd status ?delta ctx t =
   let status, (_,t) = relocate status ctx t in
index 2c1ad3b1ea84b28c451e36557c8ba16b1bffff97..c7e3ea75e509f2c9290f5046aae8be14e5d811d9 100644 (file)
@@ -57,7 +57,7 @@ val apply_subst:
  #pstatus as 'status -> NCic.context -> cic_term -> 'status * cic_term
 val fix_sorts: cic_term -> cic_term
 val saturate :
- #pstatus as 'status -> cic_term -> 'status * cic_term * cic_term list
+ #pstatus as 'status -> ?delta:int -> cic_term -> 'status * cic_term * cic_term list
 
 val get_goalty: #pstatus -> int -> cic_term
 val mk_meta: