src/HOL/Quickcheck_Exhaustive.thy
changeset 45722 63b42a7db003
parent 45718 8979b2463fc8
child 45724 1f5fc44254d7
equal deleted inserted replaced
45721:d1fb55c2ed65 45722:63b42a7db003
    17 
    17 
    18 class exhaustive = term_of +
    18 class exhaustive = term_of +
    19   fixes exhaustive :: "('a \<Rightarrow> term list option) \<Rightarrow> code_numeral \<Rightarrow> term list option"
    19   fixes exhaustive :: "('a \<Rightarrow> term list option) \<Rightarrow> code_numeral \<Rightarrow> term list option"
    20   
    20   
    21 class full_exhaustive = term_of +
    21 class full_exhaustive = term_of +
    22   fixes full_exhaustive :: "('a * (unit => term) \<Rightarrow> term list option) \<Rightarrow> code_numeral \<Rightarrow> term list option"
    22   fixes full_exhaustive :: "('a * (unit => term) \<Rightarrow> (bool * term list) option) \<Rightarrow> code_numeral \<Rightarrow> (bool * term list) option"
    23 
    23 
    24 instantiation code_numeral :: full_exhaustive
    24 instantiation code_numeral :: full_exhaustive
    25 begin
    25 begin
    26 
    26 
    27 function full_exhaustive_code_numeral' :: "(code_numeral * (unit => term) => term list option) => code_numeral => code_numeral => term list option"
    27 function full_exhaustive_code_numeral' :: "(code_numeral * (unit => term) => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
    28   where "full_exhaustive_code_numeral' f d i =
    28   where "full_exhaustive_code_numeral' f d i =
    29     (if d < i then None
    29     (if d < i then None
    30     else (f (i, %_. Code_Evaluation.term_of i)) orelse (full_exhaustive_code_numeral' f d (i + 1)))"
    30     else (f (i, %_. Code_Evaluation.term_of i)) orelse (full_exhaustive_code_numeral' f d (i + 1)))"
    31 by pat_completeness auto
    31 by pat_completeness auto
    32 
    32 
    92 end
    92 end
    93 
    93 
    94 instantiation int :: full_exhaustive
    94 instantiation int :: full_exhaustive
    95 begin
    95 begin
    96 
    96 
    97 function full_exhaustive' :: "(int * (unit => term) => term list option) => int => int => term list option"
    97 function full_exhaustive' :: "(int * (unit => term) => (bool * term list) option) => int => int => (bool * term list) option"
    98   where "full_exhaustive' f d i = (if d < i then None else (case f (i, %_. Code_Evaluation.term_of i) of Some t => Some t | None => full_exhaustive' f d (i + 1)))"
    98   where "full_exhaustive' f d i = (if d < i then None else (case f (i, %_. Code_Evaluation.term_of i) of Some t => Some t | None => full_exhaustive' f d (i + 1)))"
    99 by pat_completeness auto
    99 by pat_completeness auto
   100 
   100 
   101 termination 
   101 termination 
   102   by (relation "measure (%(_, d, i). nat (d + 1 - i))") auto
   102   by (relation "measure (%(_, d, i). nat (d + 1 - i))") auto
   152 end
   152 end
   153 
   153 
   154 instantiation "fun" :: ("{equal, full_exhaustive}", full_exhaustive) full_exhaustive
   154 instantiation "fun" :: ("{equal, full_exhaustive}", full_exhaustive) full_exhaustive
   155 begin
   155 begin
   156 
   156 
   157 fun full_exhaustive_fun' :: "(('a => 'b) * (unit => term) => term list option) => code_numeral => code_numeral => term list option"
   157 fun full_exhaustive_fun' :: "(('a => 'b) * (unit => term) => (bool * term list) option) => code_numeral => code_numeral => (bool * term list) option"
   158 where
   158 where
   159   "full_exhaustive_fun' f i d = (full_exhaustive (%(b, t). f (%_. b, %_. Code_Evaluation.Abs (STR ''x'') (Typerep.typerep TYPE('a)) (t ()))) d)
   159   "full_exhaustive_fun' f i d = (full_exhaustive (%(b, t). f (%_. b, %_. Code_Evaluation.Abs (STR ''x'') (Typerep.typerep TYPE('a)) (t ()))) d)
   160    orelse (if i > 1 then
   160    orelse (if i > 1 then
   161      full_exhaustive_fun' (%(g, gt). full_exhaustive (%(a, at). full_exhaustive (%(b, bt).
   161      full_exhaustive_fun' (%(g, gt). full_exhaustive (%(a, at). full_exhaustive (%(b, bt).
   162        f (g(a := b),
   162        f (g(a := b),
   166               in
   166               in
   167                 Code_Evaluation.App (Code_Evaluation.App (Code_Evaluation.App
   167                 Code_Evaluation.App (Code_Evaluation.App (Code_Evaluation.App
   168                   (Code_Evaluation.Const (STR ''Fun.fun_upd'') (fun (fun A B) (fun A (fun B (fun A B)))))
   168                   (Code_Evaluation.Const (STR ''Fun.fun_upd'') (fun (fun A B) (fun A (fun B (fun A B)))))
   169                 (gt ())) (at ())) (bt ())))) d) d) (i - 1) d else None)"
   169                 (gt ())) (at ())) (bt ())))) d) d) (i - 1) d else None)"
   170 
   170 
   171 definition full_exhaustive_fun :: "(('a => 'b) * (unit => term) => term list option) => code_numeral => term list option"
   171 definition full_exhaustive_fun :: "(('a => 'b) * (unit => term) => (bool * term list) option) => code_numeral => (bool * term list) option"
   172 where
   172 where
   173   "full_exhaustive_fun f d = full_exhaustive_fun' f d d" 
   173   "full_exhaustive_fun f d = full_exhaustive_fun' f d d" 
   174 
   174 
   175 instance ..
   175 instance ..
   176 
   176 
   177 end
   177 end
   178 
   178 
   179 subsubsection {* A smarter enumeration scheme for functions over finite datatypes *}
   179 subsubsection {* A smarter enumeration scheme for functions over finite datatypes *}
   180 
   180 
   181 class check_all = enum + term_of +
   181 class check_all = enum + term_of +
   182   fixes check_all :: "('a * (unit \<Rightarrow> term) \<Rightarrow> term list option) \<Rightarrow> term list option"
   182   fixes check_all :: "('a * (unit \<Rightarrow> term) \<Rightarrow> (bool * term list) option) \<Rightarrow> (bool * term list) option"
   183   fixes enum_term_of :: "'a itself \<Rightarrow> unit \<Rightarrow> term list"
   183   fixes enum_term_of :: "'a itself \<Rightarrow> unit \<Rightarrow> term list"
   184   
   184   
   185 fun check_all_n_lists :: "(('a :: check_all) list * (unit \<Rightarrow> term list) \<Rightarrow> term list option) \<Rightarrow> code_numeral \<Rightarrow> term list option"
   185 fun check_all_n_lists :: "(('a :: check_all) list * (unit \<Rightarrow> term list) \<Rightarrow> (bool * term list) option) \<Rightarrow> code_numeral \<Rightarrow> (bool * term list) option"
   186 where
   186 where
   187   "check_all_n_lists f n =
   187   "check_all_n_lists f n =
   188      (if n = 0 then f ([], (%_. [])) else check_all (%(x, xt). check_all_n_lists (%(xs, xst). f ((x # xs), (%_. (xt () # xst ())))) (n - 1)))"
   188      (if n = 0 then f ([], (%_. [])) else check_all (%(x, xt). check_all_n_lists (%(xs, xst). f ((x # xs), (%_. (xt () # xst ())))) (n - 1)))"
   189 
   189 
   190 definition mk_map_term :: " (unit \<Rightarrow> typerep) \<Rightarrow> (unit \<Rightarrow> typerep) \<Rightarrow> (unit \<Rightarrow> term list) \<Rightarrow> (unit \<Rightarrow> term list) \<Rightarrow> unit \<Rightarrow> term"
   190 definition mk_map_term :: " (unit \<Rightarrow> typerep) \<Rightarrow> (unit \<Rightarrow> typerep) \<Rightarrow> (unit \<Rightarrow> term list) \<Rightarrow> (unit \<Rightarrow> term list) \<Rightarrow> unit \<Rightarrow> term"