diff options
Diffstat (limited to 'proofs/pfedit.ml')
| -rw-r--r-- | proofs/pfedit.ml | 52 |
1 files changed, 33 insertions, 19 deletions
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml index 5d137988..e6507332 100644 --- a/proofs/pfedit.ml +++ b/proofs/pfedit.ml @@ -51,23 +51,22 @@ let _ = CErrors.register_handler begin function | _ -> raise CErrors.Unhandled end -let get_nth_V82_goal i = - let p = Proof_global.give_me_the_proof () in +let get_nth_V82_goal p i = let goals,_,_,_,sigma = Proof.proof p in try { it = List.nth goals (i-1) ; sigma } with Failure _ -> raise NoSuchGoal -let get_goal_context_gen i = - let { it=goal ; sigma=sigma; } = get_nth_V82_goal i in +let get_goal_context_gen p i = + let { it=goal ; sigma=sigma; } = get_nth_V82_goal p i in (sigma, Refiner.pf_env { it=goal ; sigma=sigma; }) let get_goal_context i = - try get_goal_context_gen i + try get_goal_context_gen (Proof_global.give_me_the_proof ()) i with Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof.") | NoSuchGoal -> CErrors.user_err Pp.(str "No such goal.") let get_current_goal_context () = - try get_goal_context_gen 1 + try get_goal_context_gen (Proof_global.give_me_the_proof ()) 1 with Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof.") | NoSuchGoal -> (* spiwack: returning empty evar_map, since if there is no goal, under focus, @@ -75,14 +74,18 @@ let get_current_goal_context () = let env = Global.env () in (Evd.from_env env, env) -let get_current_context () = - try get_goal_context_gen 1 +let get_current_context ?p () = + let current_proof_by_default = function + | Some p -> p + | None -> Proof_global.give_me_the_proof () + in + try get_goal_context_gen (current_proof_by_default p) 1 with Proof_global.NoCurrentProof -> let env = Global.env () in (Evd.from_env env, env) | NoSuchGoal -> (* No more focused goals ? *) - let p = Proof_global.give_me_the_proof () in + let p = (current_proof_by_default p) in let evd = Proof.in_proof p (fun x -> x) in (evd, Global.env ()) @@ -100,11 +103,23 @@ let solve ?with_end_tac gi info_lvl tac pr = | None -> tac | Some _ -> Proofview.Trace.record_info_trace tac in - let tac = match gi with - | Vernacexpr.SelectNth i -> Proofview.tclFOCUS i i tac - | Vernacexpr.SelectList l -> Proofview.tclFOCUSLIST l tac - | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id tac - | Vernacexpr.SelectAll -> tac + let tac = let open Goal_select in match gi with + | SelectAlreadyFocused -> + let open Proofview.Notations in + Proofview.numgoals >>= fun n -> + if n == 1 then tac + else + let e = CErrors.UserError + (None, + Pp.(str "Expected a single focused goal but " ++ + int n ++ str " goals are focused.")) + in + Proofview.tclZERO e + + | SelectNth i -> Proofview.tclFOCUS i i tac + | SelectList l -> Proofview.tclFOCUSLIST l tac + | SelectId id -> Proofview.tclFOCUSID id tac + | SelectAll -> tac in let tac = if use_unification_heuristics () then @@ -121,7 +136,7 @@ let solve ?with_end_tac gi info_lvl tac pr = with Proof_global.NoCurrentProof -> CErrors.user_err Pp.(str "No focused proof") -let by tac = Proof_global.with_current_proof (fun _ -> solve (Vernacexpr.SelectNth 1) None tac) +let by tac = Proof_global.with_current_proof (fun _ -> solve (Goal_select.SelectNth 1) None tac) let instantiate_nth_evar_com n com = Proof_global.simple_with_current_proof (fun _ p -> Proof.V82.instantiate_evar n com p) @@ -161,7 +176,7 @@ let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac = const_entry_body = Future.chain ce.const_entry_body (fun (pt, _) -> pt, ()) } in let (cb, ctx), () = Future.force ce.const_entry_body in - let univs = UState.merge side_eff Evd.univ_rigid univs ctx in + let univs = UState.merge ~sideff:side_eff ~extend:true Evd.univ_rigid univs ctx in cb, status, univs let refine_by_tactic env sigma ty tac = @@ -188,8 +203,7 @@ let refine_by_tactic env sigma ty tac = | [c, _] -> c | _ -> assert false in - let ans = Reductionops.nf_evar sigma ans in - let ans = EConstr.Unsafe.to_constr ans in + let ans = EConstr.to_constr ~abort_on_undefined_evars:false sigma ans in (** [neff] contains the freshly generated side-effects *) let neff = Evd.eval_side_effects sigma in (** Reset the old side-effects *) @@ -233,7 +247,7 @@ let apply_implicit_tactic tac = (); fun env sigma evk -> (Environ.named_context env) -> let tac = Proofview.tclTHEN tac (Proofview.tclEXTEND [] (Proofview.tclZERO (CErrors.UserError (None,Pp.str"Proof is not complete."))) []) in (try - let c = Evarutil.nf_evars_universes sigma evi.evar_concl in + let c = Evarutil.nf_evars_universes sigma (EConstr.Unsafe.to_constr evi.evar_concl) in let c = EConstr.of_constr c in if Evarutil.has_undefined_evars sigma c then raise Exit; let (ans, _, ctx) = |