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
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
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));
;;
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