let ty = NCicTypeChecker.typeof status subst metasenv ctx t in
is_a_fact status (mk_cic_term ctx ty)
-let current_goal status =
+let current_goal ?(single_goal=true) status =
let open_goals = head_goals status#stack in
- assert (List.length open_goals = 1);
+ if single_goal
+ then assert (List.length open_goals = 1)
+ else assert (List.length open_goals >= 1);
let open_goal = List.hd open_goals in
let gty = get_goalty status open_goal in
let ctx = ctx_of gty in
let add_to_trace status ~depth cache t =
match t with
| Ast.NRef _ ->
- debug_print ~depth (lazy ("Adding to trace: " ^ NotationPp.pp_term status t));
+ print ~depth (lazy ("Adding to trace: " ^ NotationPp.pp_term status t));
{cache with trace = t::cache.trace}
| Ast.NCic _ (* local candidate *)
| _ -> (*not an application *) cache
let diff = og_no - old_og_no in
debug_print (lazy ("expected branching: " ^ (string_of_int res)));
debug_print (lazy ("actual: branching" ^ (string_of_int diff)));
- (* one goal is closed by the application *)
- if og_no - old_og_no >= res then
+ (* some flexibility *)
+ if og_no - old_og_no > res then
(debug_print (lazy ("branch factor for: " ^ (ppterm status cict) ^ " = "
^ (string_of_int res) ^ " vs. " ^ (string_of_int og_no)));
debug_print ~depth (lazy "strange application"); None)
(* 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
+ let gl1,gl2 = List.partition test global_cands in
+ let ll1,ll2 = List.partition test 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 l1 = if is_eq then [Ast.Ident("refl",`Ambiguous)] else gl1@ll1 in
let l2 =
(* if smart given candidates are applied in smart mode *)
- if by && smart then []
- else if by then given_candidates
- else l2
+ if by && smart then ll2
+ else if by then given_candidates@ll2
+ else gl2@ll2
in l1,l2
in
(* we now compute candidates to be applied in smart mode, splitted in
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
+ let sgl1,sgl2 = List.partition test smart_global_cands in
+ let sll1,sll2 = List.partition test smart_local_cands in
+ let l1 = if is_eq then [] else sgl1@sll1 in
+ let l2 =
+ if by && smart then given_candidates@sll2
+ else if by then sll2
+ else sgl2@sll2
+ in l1,l2
in
candidates_facts,
smart_candidates_facts,
(NDiscriminationTree.TermSet.elements t))
)));
*)
- let candidates =
+ (* To allow using Rels in the user-specified candidates, we need a context
+ * but in the case where multiple goals are open, there is no single context
+ * to type the Rels. At this time, we require that Rels be typed in the
+ * context of the first selected goal *)
+ let _,ctx,_ = current_goal ~single_goal:false status in
+ let status, candidates =
match univ with
- | None -> None
+ | None -> status, None
| Some l ->
- let to_Ast t =
- let status, res = disambiguate status [] t None in
- let _,res = term_of_cic_term status res (ctx_of res)
- in Ast.NCic res
- in Some (List.map to_Ast l)
+ let to_Ast (st,l) t =
+ let st, res = disambiguate st ctx t None in
+ let st, res = term_of_cic_term st res (ctx_of res)
+ in (st, Ast.NCic res::l)
+ in
+ let status, l' = List.fold_left to_Ast (status,[]) l in
+ status, Some l'
in
let depth = int "depth" flags 3 in
let size = int "size" flags 10 in
| Proved (s,trace) ->
debug_print (lazy ("proved at depth " ^ string_of_int x));
List.iter (toref incr_uses statistics) trace;
+ let _ = debug_print (pptrace status trace) in
let trace = cleanup_trace s trace in
let _ = debug_print (pptrace status trace) in
let stack =