+let get_candidates ?(smart=true) depth flags status cache signature gty =
+ let universe = status#auto_cache in
+ let _,_,metasenv,subst,_ = status#obj in
+ let context = ctx_of gty in
+ let _, raw_gty = term_of_cic_term status gty context in
+ let is_prod, is_eq =
+ let status, t = term_of_cic_term status gty context in
+ let t = NCicReduction.whd status subst context t in
+ match t with
+ | NCic.Prod _ -> true, false
+ | _ -> false, NCicParamod.is_equation status metasenv subst context t
+ in
+ debug_print ~depth (lazy ("gty:" ^ NTacStatus.ppterm status gty));
+ let is_eq =
+ NCicParamod.is_equation status metasenv subst context raw_gty
+ in
+ let raw_weak_gty, weak_gty =
+ if smart then
+ match raw_gty with
+ | NCic.Appl _
+ | NCic.Const _
+ | NCic.Rel _ ->
+ let raw_weak =
+ perforate_small status subst metasenv context raw_gty in
+ let weak = mk_cic_term context raw_weak in
+ debug_print ~depth (lazy ("weak_gty:" ^ NTacStatus.ppterm status weak));
+ Some raw_weak, Some (weak)
+ | _ -> None,None
+ else None,None
+ in
+ (* we now compute global candidates *)
+ let global_cands, smart_global_cands =
+ let mapf s =
+ let to_ast = function
+ | NCic.Const r when true
+ (*is_relevant statistics r*) -> Some (Ast.NRef r)
+ (* | NCic.Const _ -> None *)
+ | _ -> assert false in
+ HExtlib.filter_map
+ to_ast (NDiscriminationTree.TermSet.elements s) in
+ let g,l =
+ get_cands
+ (NDiscriminationTree.DiscriminationTree.retrieve_unifiables universe)
+ NDiscriminationTree.TermSet.diff
+ NDiscriminationTree.TermSet.empty
+ raw_gty raw_weak_gty in
+ mapf g, mapf l in
+ (* we now compute local candidates *)
+ let local_cands,smart_local_cands =
+ let mapf s =
+ let to_ast t =
+ let _status, t = term_of_cic_term status t context
+ in Ast.NCic t in
+ List.map to_ast (Ncic_termSet.elements s) in
+ let g,l =
+ get_cands
+ (fun ty -> search_in_th ty cache)
+ Ncic_termSet.diff Ncic_termSet.empty gty weak_gty in
+ mapf g, mapf l in
+ (* we now splits candidates in facts or not facts *)
+ let test = is_a_fact_ast status subst metasenv context in
+ let by,given_candidates =
+ match flags.candidates with
+ | Some l -> true, l
+ | None -> false, [] in
+ (* we compute candidates to be applied in normal mode, splitted in
+ facts and not facts *)
+ let candidates_facts,candidates_other =
+ (* warning : the order between global_cands and local_cand is
+ relevant. In this way we process first local cands *)
+ let l1,l2 = List.partition test (global_cands@local_cands) in
+ (* if the goal is an equation we avoid to apply unit equalities,
+ since superposition should take care of them; refl is an
+ exception since it prompts for convertibility *)
+ let l1 = if is_eq then [Ast.Ident("refl",`Ambiguous)] else l1 in
+ let l2 =
+ (* if smart given candidates are applied in smart mode *)
+ if by && smart then []
+ else if by then given_candidates
+ else l2
+ in l1,l2
+ in
+ (* we now compute candidates to be applied in smart mode, splitted in
+ facts and not facts *)
+ let smart_candidates_facts, smart_candidates_other =
+ if is_prod || not(smart) then [],[]
+ else
+ let l1,l2 = List.partition test (smart_local_cands@smart_global_cands) in
+ let l1 = if is_eq then [] else l1 in
+ let l2 = if by then given_candidates else l2
+ in
+ l1,l2
+ in
+ candidates_facts,
+ smart_candidates_facts,
+ sort_candidates status context (candidates_other),
+ sort_candidates status context (smart_candidates_other)
+;;
+
+let applicative_case depth signature status flags gty cache =
+ app_counter:= !app_counter+1;
+ let _,_,metasenv,subst,_ = status#obj in
+ let context = ctx_of gty in
+ let tcache = cache.facts in
+ let is_prod, is_eq =
+ let status, t = term_of_cic_term status gty context in
+ let t = NCicReduction.whd status subst context t in
+ match t with
+ | NCic.Prod _ -> true, false
+ | _ -> false, NCicParamod.is_equation status metasenv subst context t
+ in
+ debug_print ~depth (lazy (string_of_bool is_eq));
+ (* new *)
+ let candidates_facts, smart_candidates_facts,
+ candidates_other, smart_candidates_other =
+ get_candidates ~smart:true depth
+ flags status tcache signature gty
+ in
+ let sm = if is_eq || is_prod then 0 else 2 in
+ let sm1 = if flags.last then 2 else 0 in
+ let maxd = (depth + 1 = flags.maxdepth) in
+ let try_candidates only_one sm acc candidates =
+ List.fold_left
+ (fun elems cand ->
+ if (only_one && (elems <> [])) then elems
+ else
+ match try_candidate (~smart:sm)
+ flags depth status cache.unit_eq context cand with
+ | None -> elems
+ | Some x -> x::elems)
+ acc candidates
+ in
+ (* if the goal is the last one we stop at the first fact *)
+ let elems = try_candidates flags.last sm [] candidates_facts in
+ (* now we add smart_facts *)
+ let elems = try_candidates flags.last sm elems smart_candidates_facts in
+ (* if we are at maxdepth and the goal is not a product we are done
+ similarly, if the goal is the last one and we already found a
+ solution *)
+ if (maxd && not(is_prod)) || (flags.last && elems<>[]) then elems
+ else
+ let elems = try_candidates false 2 elems candidates_other in
+ debug_print ~depth (lazy ("not facts: try smart application"));
+ try_candidates false 2 elems smart_candidates_other
+;;
+
+
+(*