diff options
Diffstat (limited to 'proofs')
| -rw-r--r-- | proofs/logic.ml | 14 | ||||
| -rw-r--r-- | proofs/logic.mli | 3 | ||||
| -rw-r--r-- | proofs/pfedit.ml | 10 | ||||
| -rw-r--r-- | proofs/pfedit.mli | 6 | ||||
| -rw-r--r-- | proofs/proof_type.mli | 1 | ||||
| -rw-r--r-- | proofs/tacmach.ml | 4 | ||||
| -rw-r--r-- | proofs/tacmach.mli | 1 |
7 files changed, 17 insertions, 22 deletions
diff --git a/proofs/logic.ml b/proofs/logic.ml index aa0b9bac6f..e4c833627a 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -276,6 +276,11 @@ let move_hyp toleft (left,declfrom,right) hto = List.fold_left (fun sign d -> push_named_context_val d sign) right left +let move_hyp_in_named_context hfrom hto sign = + let (left,right,declfrom,toleft) = + split_sign hfrom hto (named_context_of_val sign) in + move_hyp toleft (left,declfrom,right) hto + (**********************************************************************) @@ -549,12 +554,3 @@ let prim_refiner r sigma goal = let sgl = List.rev sgl in let sigma = Goal.V82.partial_solution sigma goal oterm in (sgl, sigma) - - | Move (hfrom, hto) -> - let (left,right,declfrom,toleft) = - split_sign hfrom hto (named_context_of_val sign) in - let hyps' = - move_hyp toleft (left,declfrom,right) hto in - let (gl,ev,sigma) = mk_goal hyps' cl in - let sigma = Goal.V82.partial_solution_to sigma goal gl ev in - ([gl], sigma) diff --git a/proofs/logic.mli b/proofs/logic.mli index 2764d28c02..0dba9ef1ee 100644 --- a/proofs/logic.mli +++ b/proofs/logic.mli @@ -56,3 +56,6 @@ val catchable_exception : exn -> bool val convert_hyp : bool -> Environ.named_context_val -> evar_map -> Context.Named.Declaration.t -> Environ.named_context_val + +val move_hyp_in_named_context : Id.t -> Id.t Misctypes.move_location -> + Environ.named_context_val -> Environ.named_context_val diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml index e4bae20128..a3ece19134 100644 --- a/proofs/pfedit.ml +++ b/proofs/pfedit.ml @@ -161,11 +161,12 @@ let build_constant_by_tactic id ctx sign ?(goal_kind = Global, false, Proof Theo delete_current_proof (); iraise reraise -let build_by_tactic ?(side_eff=true) env ctx ?(poly=false) typ tac = +let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac = let id = Id.of_string ("temporary_proof"^string_of_int (next())) in let sign = val_of_named_context (named_context env) in let gk = Global, poly, Proof Theorem in - let ce, status, univs = build_constant_by_tactic id ctx sign ~goal_kind:gk typ tac in + let ce, status, univs = + build_constant_by_tactic id sigma sign ~goal_kind:gk typ tac in let ce = if side_eff then Safe_typing.inline_private_constants_in_definition_entry env ce else { ce with @@ -232,8 +233,9 @@ let solve_by_implicit_tactic env sigma evk = (try let c = Evarutil.nf_evars_universes sigma evi.evar_concl in if Evarutil.has_undefined_evars sigma c then raise Exit; - let (ans, _, _) = + let (ans, _, ctx) = build_by_tactic env (Evd.evar_universe_context sigma) c tac in - ans + let sigma = Evd.set_universe_context sigma ctx in + sigma, ans with e when Logic.catchable_exception e -> raise Exit) | _ -> raise Exit diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli index 666730e1af..ea604e08eb 100644 --- a/proofs/pfedit.mli +++ b/proofs/pfedit.mli @@ -167,7 +167,8 @@ val instantiate_nth_evar_com : int -> Constrexpr.constr_expr -> unit val build_constant_by_tactic : Id.t -> Evd.evar_universe_context -> named_context_val -> ?goal_kind:goal_kind -> types -> unit Proofview.tactic -> - Safe_typing.private_constants Entries.definition_entry * bool * Evd.evar_universe_context + Safe_typing.private_constants Entries.definition_entry * bool * + Evd.evar_universe_context val build_by_tactic : ?side_eff:bool -> env -> Evd.evar_universe_context -> ?poly:polymorphic -> types -> unit Proofview.tactic -> @@ -189,5 +190,4 @@ val declare_implicit_tactic : unit Proofview.tactic -> unit val clear_implicit_tactic : unit -> unit (* Raise Exit if cannot solve *) -(* FIXME: interface: it may incur some new universes etc... *) -val solve_by_implicit_tactic : env -> Evd.evar_map -> Evd.evar -> constr +val solve_by_implicit_tactic : env -> Evd.evar_map -> Evd.evar -> Evd.evar_map * constr diff --git a/proofs/proof_type.mli b/proofs/proof_type.mli index f7798a0edb..c120796220 100644 --- a/proofs/proof_type.mli +++ b/proofs/proof_type.mli @@ -22,7 +22,6 @@ open Misctypes type prim_rule = | Cut of bool * bool * Id.t * types | Refine of constr - | Move of Id.t * Id.t move_location (** Nowadays, the only rules we'll consider are the primitive rules *) diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml index 50984c48e0..b9330ff007 100644 --- a/proofs/tacmach.ml +++ b/proofs/tacmach.ml @@ -121,15 +121,11 @@ let internal_cut_rev_no_check replace id t gl = let refine_no_check c gl = refiner (Refine c) gl -let move_hyp_no_check id1 id2 gl = - refiner (Move (id1,id2)) gl - (* Versions with consistency checks *) let internal_cut b d t = with_check (internal_cut_no_check b d t) let internal_cut_rev b d t = with_check (internal_cut_rev_no_check b d t) let refine c = with_check (refine_no_check c) -let move_hyp id id' = with_check (move_hyp_no_check id id') (* Pretty-printers *) diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli index 100ed1522e..727efcf6dc 100644 --- a/proofs/tacmach.mli +++ b/proofs/tacmach.mli @@ -92,7 +92,6 @@ val refine_no_check : constr -> tactic val internal_cut : bool -> Id.t -> types -> tactic val internal_cut_rev : bool -> Id.t -> types -> tactic val refine : constr -> tactic -val move_hyp : Id.t -> Id.t move_location -> tactic (** {6 Pretty-printing functions (debug only). } *) val pr_gls : goal sigma -> Pp.std_ppcmds |