updated changes from upstream (AFP)
authorChristian Urban <christian dot urban at kcl dot ac dot uk>
Fri, 16 May 2014 08:38:23 +0100
changeset 3233 9ae285ce814e
parent 3232 7bc38b93a1fc
child 3234 08c3ef07cef7
updated changes from upstream (AFP)
Nominal/Nominal2.thy
Nominal/Nominal2_Base.thy
Nominal/nominal_atoms.ML
Nominal/nominal_function.ML
Nominal/nominal_library.ML
Nominal/nominal_thmdecls.ML
--- a/Nominal/Nominal2.thy	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/Nominal2.thy	Fri May 16 08:38:23 2014 +0100
@@ -178,9 +178,8 @@
   val raw_induct_thms = #inducts (hd dtinfos)
   val raw_exhaust_thms = map #exhaust dtinfos
   val raw_size_trms = map HOLogic.size_const raw_tys
-  val raw_size_thms = Size.size_thms (Proof_Context.theory_of lthy1) (hd raw_full_dt_names')
-    |> `(fn thms => (length thms) div 2)
-    |> uncurry drop
+  val raw_size_thms = these (Option.map ((fn ths => drop (length ths div 2) ths) o fst o snd)
+    (BNF_LFP_Size.lookup_size lthy1 (hd raw_full_dt_names')))
 
   val raw_result = RawDtInfo 
     {raw_dt_names = raw_full_dt_names',
--- a/Nominal/Nominal2_Base.thy	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/Nominal2_Base.thy	Fri May 16 08:38:23 2014 +0100
@@ -2951,13 +2951,13 @@
 
 
 simproc_setup fresh_ineq ("x \<noteq> (y::'a::at_base)") = {* fn _ => fn ctxt => fn ctrm =>
-  case term_of ctrm of @{term "HOL.Not"} $ (Const ("HOL.eq", _) $ lhs $ rhs) =>
+  case term_of ctrm of @{term "HOL.Not"} $ (Const (@{const_name HOL.eq}, _) $ lhs $ rhs) =>
     let  
 
       fun first_is_neg lhs rhs [] = NONE
         | first_is_neg lhs rhs (thm::thms) =
           (case Thm.prop_of thm of
-             _ $ (@{term "HOL.Not"} $ (Const ("HOL.eq", _) $ l $ r)) =>
+             _ $ (@{term "HOL.Not"} $ (Const (@{const_name HOL.eq}, _) $ l $ r)) =>
                (if l = lhs andalso r = rhs then SOME(thm)
                 else if r = lhs andalso l = rhs then SOME(thm RS @{thm not_sym})
                 else first_is_neg lhs rhs thms)  
--- a/Nominal/nominal_atoms.ML	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/nominal_atoms.ML	Fri May 16 08:38:23 2014 +0100
@@ -28,7 +28,7 @@
 
 fun add_atom_decl (name : binding, arg : binding option) (thy : theory) =
   let
-    val _ = Theory.requires thy "Nominal2_Base" "nominal logic";
+    val _ = Theory.requires thy (Context.theory_name @{theory}) "nominal logic";
     val str = Sign.full_name thy name;
 
     (* typedef *)
@@ -80,6 +80,6 @@
   Outer_Syntax.command @{command_spec "atom_decl"}
     "declaration of a concrete atom type" 
       ((Parse.binding -- Scan.option (Args.parens (Parse.binding))) >>
-        (Toplevel.print oo (Toplevel.theory o add_atom_decl)))
+        (Toplevel.theory o add_atom_decl))
 
 end;
--- a/Nominal/nominal_function.ML	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/nominal_function.ML	Fri May 16 08:38:23 2014 +0100
@@ -181,7 +181,8 @@
           pinducts=snd pinducts', simps=NONE, inducts=NONE, termination=termination',
           fs=fs, R=R, defname=defname, is_partial=true, eqvts=eqvts}
 
-        val _ = Proof_Display.print_consts do_print lthy (K false) (map fst fixes)
+        val _ = Proof_Display.print_consts do_print 
+          (Position.thread_data ()) lthy (K false) (map fst fixes)
       in
         (info, 
          lthy |> Local_Theory.declaration {syntax = false, pervasive = false} 
--- a/Nominal/nominal_library.ML	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/nominal_library.ML	Fri May 16 08:38:23 2014 +0100
@@ -298,8 +298,7 @@
 (* decompses a formula into params, premises and a conclusion *)
 fun strip_full_horn trm =
   let
-    fun strip_outer_params (Const (@{const_name Pure.all}, _) $ Abs (a, T, t)) = 
-      strip_outer_params t |>> cons (a, T)
+    fun strip_outer_params (Const (@{const_name Pure.all}, _) $ Abs (a, T, t)) = strip_outer_params t |>> cons (a, T)
     | strip_outer_params B = ([], B)
 
     val (params, body) = strip_outer_params trm
@@ -365,13 +364,13 @@
 
 val natT = @{typ nat}
     
-fun prod_size_const T1 T2 = 
+fun size_prod_const T1 T2 = 
   let
     val T1_fun = T1 --> natT
     val T2_fun = T2 --> natT
     val prodT = HOLogic.mk_prodT (T1, T2)
   in
-    Const (@{const_name prod_size}, [T1_fun, T2_fun, prodT] ---> natT)
+    Const (@{const_name size_prod}, [T1_fun, T2_fun, prodT] ---> natT)
   end
 
 fun snd_const T1 T2 =
@@ -409,7 +408,7 @@
       (Type (@{type_name Sum_Type.sum}, [T1, T2])) =>
          Sum_Tree.mk_sumcase T1 T2 natT (mk_size_measure T1) (mk_size_measure T2)
     | (Type (@{type_name Product_Type.prod}, [T1, T2])) =>
-         prod_size_const T1 T2 $ (mk_size_measure T1) $ (mk_size_measure T2)
+         size_prod_const T1 T2 $ (mk_size_measure T1) $ (mk_size_measure T2)
     | _ => HOLogic.size_const T
 
   val measure_trm = mk_measure_trm (mk_size_measure) ctxt
--- a/Nominal/nominal_thmdecls.ML	Sun Apr 06 13:07:24 2014 +0100
+++ b/Nominal/nominal_thmdecls.ML	Fri May 16 08:38:23 2014 +0100
@@ -112,7 +112,7 @@
          Syntax.string_of_term (Context.proof_of context) (prop_of thm))
   in
     case prop_of thm of
-      Const ("Pure.eq", _) $ (Const (@{const_name "permute"}, _) $ p $ c) $ c' =>
+      Const (@{const_name Pure.eq}, _) $ (Const (@{const_name "permute"}, _) $ p $ c) $ c' =>
         if is_Var p andalso is_fixed (Context.proof_of context) c andalso c aconv c' then
           c
         else
@@ -256,7 +256,7 @@
 fun eqvt_transform ctxt thm =
   (case prop_of thm of @{const "Trueprop"} $ _ =>
     thm_4_of_1 ctxt thm
-  | @{const "Pure.imp"} $ _ $ _ =>
+  | @{const Pure.imp} $ _ $ _ =>
     thm_4_of_1 ctxt (thm_1_of_2 ctxt thm)
   | _ =>
     error msg)
@@ -279,7 +279,7 @@
     in
       (th', thm_4_of_1 ctxt thm)
     end
-  | @{const "Pure.imp"} $ _ $ _ =>
+  | @{const Pure.imp} $ _ $ _ =>
     let
       val th1 = thm_1_of_2 ctxt thm
     in