# HG changeset patch # User Christian Urban # Date 1400225903 -3600 # Node ID 9ae285ce814ef836ac63078d4ed09eb87c5f4c8d # Parent 7bc38b93a1fccac2d92ac6f9f28a2006d13a41ed updated changes from upstream (AFP) diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/Nominal2.thy --- 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', diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/Nominal2_Base.thy --- 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 \ (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) diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/nominal_atoms.ML --- 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; diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/nominal_function.ML --- 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} diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/nominal_library.ML --- 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 diff -r 7bc38b93a1fc -r 9ae285ce814e Nominal/nominal_thmdecls.ML --- 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