src/Pure/assumption.ML
changeset 54984 da70ab8531f4
parent 54883 dd04a8b654fc
child 59150 71b416020f42
     1.1 --- a/src/Pure/assumption.ML	Fri Jan 10 17:44:41 2014 +0100
     1.2 +++ b/src/Pure/assumption.ML	Fri Jan 10 21:37:28 2014 +0100
     1.3 @@ -10,9 +10,9 @@
     1.4    val assume_export: export
     1.5    val presume_export: export
     1.6    val assume: Proof.context -> cterm -> thm
     1.7 +  val assume_hyps: cterm -> Proof.context -> thm * Proof.context
     1.8    val all_assms_of: Proof.context -> cterm list
     1.9    val all_prems_of: Proof.context -> thm list
    1.10 -  val check_hyps: Proof.context -> thm -> thm
    1.11    val local_assms_of: Proof.context -> Proof.context -> cterm list
    1.12    val local_prems_of: Proof.context -> Proof.context -> thm list
    1.13    val add_assms: export -> cterm list -> Proof.context -> thm list * Proof.context
    1.14 @@ -48,8 +48,13 @@
    1.15  *)
    1.16  fun presume_export _ = assume_export false;
    1.17  
    1.18 +
    1.19  fun assume ctxt = Raw_Simplifier.norm_hhf ctxt o Thm.assume;
    1.20  
    1.21 +fun assume_hyps ct ctxt =
    1.22 +  let val (th, ctxt') = Thm.assume_hyps ct ctxt
    1.23 +  in (Raw_Simplifier.norm_hhf ctxt' th, ctxt') end;
    1.24 +
    1.25  
    1.26  
    1.27  (** local context data **)
    1.28 @@ -76,13 +81,6 @@
    1.29  val all_assms_of = maps #2 o all_assumptions_of;
    1.30  val all_prems_of = #prems o rep_data;
    1.31  
    1.32 -fun check_hyps ctxt th =
    1.33 -  let
    1.34 -    val extra_hyps = subtract (op aconv) (map Thm.term_of (all_assms_of ctxt)) (Thm.hyps_of th);
    1.35 -    val _ = null extra_hyps orelse
    1.36 -      error ("Additional hypotheses:\n" ^ cat_lines (map (Syntax.string_of_term ctxt) extra_hyps));
    1.37 -  in th end;
    1.38 -
    1.39  
    1.40  (* local assumptions *)
    1.41  
    1.42 @@ -98,8 +96,8 @@
    1.43  (* add assumptions *)
    1.44  
    1.45  fun add_assms export new_asms ctxt =
    1.46 -  let val new_prems = map (assume ctxt) new_asms in
    1.47 -    ctxt
    1.48 +  let val (new_prems, ctxt') = fold_map assume_hyps new_asms ctxt in
    1.49 +    ctxt'
    1.50      |> map_data (fn (asms, prems) => (asms @ [(export, new_asms)], prems @ new_prems))
    1.51      |> pair new_prems
    1.52    end;