src/HOL/Quickcheck_Narrowing.thy
changeset 58152 6fe60a9a5bad
parent 56401 3b2db6132bfd
child 58310 91ea607a34d8
     1.1 --- a/src/HOL/Quickcheck_Narrowing.thy	Wed Sep 03 00:06:23 2014 +0200
     1.2 +++ b/src/HOL/Quickcheck_Narrowing.thy	Wed Sep 03 00:06:24 2014 +0200
     1.3 @@ -26,13 +26,19 @@
     1.4  
     1.5  subsubsection {* Narrowing's deep representation of types and terms *}
     1.6  
     1.7 -datatype narrowing_type = Narrowing_sum_of_products "narrowing_type list list"
     1.8 -datatype narrowing_term = Narrowing_variable "integer list" narrowing_type | Narrowing_constructor integer "narrowing_term list"
     1.9 -datatype 'a narrowing_cons = Narrowing_cons narrowing_type "(narrowing_term list => 'a) list"
    1.10 +datatype_new narrowing_type =
    1.11 +  Narrowing_sum_of_products "narrowing_type list list"
    1.12 +
    1.13 +datatype_new narrowing_term =
    1.14 +  Narrowing_variable "integer list" narrowing_type
    1.15 +| Narrowing_constructor integer "narrowing_term list"
    1.16 +
    1.17 +datatype_new (dead 'a) narrowing_cons =
    1.18 +  Narrowing_cons narrowing_type "(narrowing_term list \<Rightarrow> 'a) list"
    1.19  
    1.20  primrec map_cons :: "('a => 'b) => 'a narrowing_cons => 'b narrowing_cons"
    1.21  where
    1.22 -  "map_cons f (Narrowing_cons ty cs) = Narrowing_cons ty (map (%c. f o c) cs)"
    1.23 +  "map_cons f (Narrowing_cons ty cs) = Narrowing_cons ty (map (\<lambda>c. f o c) cs)"
    1.24  
    1.25  subsubsection {* From narrowing's deep representation of terms to @{theory Code_Evaluation}'s terms *}
    1.26  
    1.27 @@ -70,7 +76,7 @@
    1.28    
    1.29  definition cons :: "'a => 'a narrowing"
    1.30  where
    1.31 -  "cons a d = (Narrowing_cons (Narrowing_sum_of_products [[]]) [(%_. a)])"
    1.32 +  "cons a d = (Narrowing_cons (Narrowing_sum_of_products [[]]) [(\<lambda>_. a)])"
    1.33  
    1.34  fun conv :: "(narrowing_term list => 'a) list => narrowing_term => 'a"
    1.35  where
    1.36 @@ -88,7 +94,7 @@
    1.37         case a (d - 1) of Narrowing_cons ta cas =>
    1.38         let
    1.39           shallow = (d > 0 \<and> non_empty ta);
    1.40 -         cs = [(%xs'. (case xs' of [] => undefined | x # xs => cf xs (conv cas x))). shallow, cf <- cfs]
    1.41 +         cs = [(\<lambda>xs'. (case xs' of [] => undefined | x # xs => cf xs (conv cas x))). shallow, cf <- cfs]
    1.42         in Narrowing_cons (Narrowing_sum_of_products [ta # p. shallow, p <- ps]) cs)"
    1.43  
    1.44  definition sum :: "'a narrowing => 'a narrowing => 'a narrowing"
    1.45 @@ -121,7 +127,7 @@
    1.46  class narrowing =
    1.47    fixes narrowing :: "integer => 'a narrowing_cons"
    1.48  
    1.49 -datatype property = Universal narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Existential narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Property bool
    1.50 +datatype_new property = Universal narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Existential narrowing_type "(narrowing_term => property)" "narrowing_term => Code_Evaluation.term" | Property bool
    1.51  
    1.52  (* FIXME: hard-wired maximal depth of 100 here *)
    1.53  definition exists :: "('a :: {narrowing, partial_term_of} => property) => property"
    1.54 @@ -149,7 +155,7 @@
    1.55  
    1.56  subsubsection {* Defining a simple datatype to represent functions in an incomplete and redundant way *}
    1.57  
    1.58 -datatype ('a, 'b) ffun = Constant 'b | Update 'a 'b "('a, 'b) ffun"
    1.59 +datatype_new (dead 'a, dead 'b) ffun = Constant 'b | Update 'a 'b "('a, 'b) ffun"
    1.60  
    1.61  primrec eval_ffun :: "('a, 'b) ffun => 'a => 'b"
    1.62  where
    1.63 @@ -159,7 +165,7 @@
    1.64  hide_type (open) ffun
    1.65  hide_const (open) Constant Update eval_ffun
    1.66  
    1.67 -datatype 'b cfun = Constant 'b
    1.68 +datatype_new (dead 'b) cfun = Constant 'b
    1.69  
    1.70  primrec eval_cfun :: "'b cfun => 'a => 'b"
    1.71  where
    1.72 @@ -308,4 +314,3 @@
    1.73  hide_fact empty_def cons_def conv.simps non_empty.simps apply_def sum_def ensure_testable_def all_def exists_def
    1.74  
    1.75  end
    1.76 -