merged
authorwenzelm
Wed, 27 May 2009 22:20:29 +0200
changeset 31270 40c00d684800
parent 31269 dcbe1f9fe2cd (diff)
parent 31265 18085db7b147 (current diff)
child 31272 703183ff0926
merged
--- a/src/HOL/Code_Numeral.thy	Wed May 27 21:08:47 2009 +0200
+++ b/src/HOL/Code_Numeral.thy	Wed May 27 22:20:29 2009 +0200
@@ -215,7 +215,13 @@
   "of_nat n < of_nat m \<longleftrightarrow> n < m"
   by simp
 
-lemma Suc_code_numeral_minus_one: "Suc_code_numeral n - 1 = n" by simp
+lemma code_numeral_zero_minus_one:
+  "(0::code_numeral) - 1 = 0"
+  by simp
+
+lemma Suc_code_numeral_minus_one:
+  "Suc_code_numeral n - 1 = n"
+  by simp
 
 lemma of_nat_code [code]:
   "of_nat = Nat.of_nat"
--- a/src/HOL/Quickcheck.thy	Wed May 27 21:08:47 2009 +0200
+++ b/src/HOL/Quickcheck.thy	Wed May 27 22:20:29 2009 +0200
@@ -73,6 +73,10 @@
 definition beyond :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
   "beyond k l = (if l > k then l else 0)"
 
+lemma beyond_zero:
+  "beyond k 0 = 0"
+  by (simp add: beyond_def)
+
 use "Tools/quickcheck_generators.ML"
 setup {* Quickcheck_Generators.setup *}
 
@@ -100,6 +104,8 @@
 end
 
 
+hide (open) const collapse beyond
+
 no_notation fcomp (infixl "o>" 60)
 no_notation scomp (infixl "o\<rightarrow>" 60)
 
--- a/src/HOL/Random.thy	Wed May 27 21:08:47 2009 +0200
+++ b/src/HOL/Random.thy	Wed May 27 22:20:29 2009 +0200
@@ -118,6 +118,10 @@
   then show ?thesis by (simp add: select_weight_def scomp_def split_def) 
 qed
 
+lemma select_weight_cons_zero:
+  "select_weight ((0, x) # xs) = select_weight xs"
+  by (simp add: select_weight_def)
+
 lemma select_weigth_drop_zero:
   "select_weight (filter (\<lambda>(k, _). k > 0) xs) = select_weight xs"
 proof -
--- a/src/HOL/Tools/primrec_package.ML	Wed May 27 21:08:47 2009 +0200
+++ b/src/HOL/Tools/primrec_package.ML	Wed May 27 22:20:29 2009 +0200
@@ -16,7 +16,7 @@
   val add_primrec_overloaded: (string * (string * typ) * bool) list ->
     (binding * typ option * mixfix) list ->
     (Attrib.binding * term) list -> theory -> thm list * theory
-  val add_primrec_simple: ((binding * typ) * mixfix) list -> (binding * term) list ->
+  val add_primrec_simple: ((binding * typ) * mixfix) list -> term list ->
     local_theory -> (string * thm list list) * local_theory
 end;
 
@@ -252,9 +252,9 @@
 
 (* primrec definition *)
 
-fun add_primrec_simple fixes spec lthy =
+fun add_primrec_simple fixes ts lthy =
   let
-    val ((prefix, (fs, defs)), prove) = distill lthy fixes (map snd spec);
+    val ((prefix, (fs, defs)), prove) = distill lthy fixes ts;
   in
     lthy
     |> fold_map (LocalTheory.define Thm.definitionK) defs
@@ -274,7 +274,7 @@
   in
     lthy
     |> set_group ? LocalTheory.set_group (serial_string ())
-    |> add_primrec_simple fixes spec
+    |> add_primrec_simple fixes (map snd spec)
     |-> (fn (prefix, simps) => fold_map (LocalTheory.note Thm.generatedK)
           (attr_bindings prefix ~~ simps)
     #-> (fn simps' => LocalTheory.note Thm.generatedK