more official Thm.eq_thm_strict, without demanding ML equality type;
authorwenzelm
Wed, 17 Jul 2013 11:38:57 +0200
changeset 53820fb028440473e
parent 53819 77146b576ac7
child 53821 8d749ebd9ab8
more official Thm.eq_thm_strict, without demanding ML equality type;
src/Pure/Isar/attrib.ML
src/Pure/more_thm.ML
     1.1 --- a/src/Pure/Isar/attrib.ML	Wed Jul 17 09:32:08 2013 +0200
     1.2 +++ b/src/Pure/Isar/attrib.ML	Wed Jul 17 11:38:57 2013 +0200
     1.3 @@ -252,8 +252,6 @@
     1.4  
     1.5  local
     1.6  
     1.7 -val strict_eq_thm = op = o pairself Thm.rep_thm;
     1.8 -
     1.9  fun apply_att src (context, th) =
    1.10    let
    1.11      val src1 = Args.assignable src;
    1.12 @@ -275,7 +273,7 @@
    1.13            (case decls of
    1.14              [] => [(th, [src'])]
    1.15            | (th2, srcs2) :: rest =>
    1.16 -              if strict_eq_thm (th, th2)
    1.17 +              if Thm.eq_thm_strict (th, th2)
    1.18                then ((th2, src' :: srcs2) :: rest)
    1.19                else (th, [src']) :: (th2, srcs2) :: rest);
    1.20        in ((th, NONE), (decls', context')) end
    1.21 @@ -308,7 +306,7 @@
    1.22            |>> flat;
    1.23          val decls' = rev (map (apsnd rev) decls);
    1.24          val facts' =
    1.25 -          if eq_list (eq_fst strict_eq_thm) (decls', fact') then
    1.26 +          if eq_list (eq_fst Thm.eq_thm_strict) (decls', fact') then
    1.27              [((b, []), map2 (fn (th, atts1) => fn (_, atts2) => (th, atts1 @ atts2)) decls' fact')]
    1.28            else if null decls' then [((b, []), fact')]
    1.29            else [(empty_binding, decls'), ((b, []), fact')];
     2.1 --- a/src/Pure/more_thm.ML	Wed Jul 17 09:32:08 2013 +0200
     2.2 +++ b/src/Pure/more_thm.ML	Wed Jul 17 11:38:57 2013 +0200
     2.3 @@ -39,6 +39,7 @@
     2.4    val eq_thm: thm * thm -> bool
     2.5    val eq_thm_thy: thm * thm -> bool
     2.6    val eq_thm_prop: thm * thm -> bool
     2.7 +  val eq_thm_strict: thm * thm -> bool
     2.8    val equiv_thm: thm * thm -> bool
     2.9    val class_triv: theory -> class -> thm
    2.10    val of_sort: ctyp * sort -> thm list
    2.11 @@ -192,6 +193,11 @@
    2.12  val eq_thm_thy = Theory.eq_thy o pairself Thm.theory_of_thm;
    2.13  val eq_thm_prop = op aconv o pairself Thm.full_prop_of;
    2.14  
    2.15 +fun eq_thm_strict ths =
    2.16 +  eq_thm_thy ths andalso eq_thm ths andalso
    2.17 +    let val (rep1, rep2) = pairself Thm.rep_thm ths
    2.18 +    in #maxidx rep1 = #maxidx rep2 andalso #tags rep1 = #tags rep2 end;
    2.19 +
    2.20  
    2.21  (* pattern equivalence *)
    2.22