src/HOL/Library/Predicate_Compile_Alternative_Defs.thy
changeset 69593 3dda49e08b9d
parent 68028 1f9f973eed2a
equal deleted inserted replaced
69592:a80d8ec6c998 69593:3dda49e08b9d
    20 
    20 
    21 lemma [code_pred_inline]: 
    21 lemma [code_pred_inline]: 
    22   "((A::bool) \<noteq> (B::bool)) = ((A \<and> \<not> B) \<or> (B \<and> \<not> A))"
    22   "((A::bool) \<noteq> (B::bool)) = ((A \<and> \<not> B) \<or> (B \<and> \<not> A))"
    23 by fast
    23 by fast
    24 
    24 
    25 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Let}]\<close>
    25 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Let\<close>]\<close>
    26 
    26 
    27 section \<open>Pairs\<close>
    27 section \<open>Pairs\<close>
    28 
    28 
    29 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name case_prod}]\<close>
    29 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>fst\<close>, \<^const_name>\<open>snd\<close>, \<^const_name>\<open>case_prod\<close>]\<close>
    30 
    30 
    31 section \<open>Filters\<close>
    31 section \<open>Filters\<close>
    32 
    32 
    33 (*TODO: shouldn't this be done by typedef? *)
    33 (*TODO: shouldn't this be done by typedef? *)
    34 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Abs_filter}, @{const_name Rep_filter}]\<close>
    34 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Abs_filter\<close>, \<^const_name>\<open>Rep_filter\<close>]\<close>
    35 
    35 
    36 section \<open>Bounded quantifiers\<close>
    36 section \<open>Bounded quantifiers\<close>
    37 
    37 
    38 declare Ball_def[code_pred_inline]
    38 declare Ball_def[code_pred_inline]
    39 declare Bex_def[code_pred_inline]
    39 declare Bex_def[code_pred_inline]
    52   "A = B \<longleftrightarrow> (\<forall>x. A x \<longrightarrow> B x) \<and> (\<forall>x. B x \<longrightarrow> A x)"
    52   "A = B \<longleftrightarrow> (\<forall>x. A x \<longrightarrow> B x) \<and> (\<forall>x. B x \<longrightarrow> A x)"
    53   by (auto simp add: fun_eq_iff)
    53   by (auto simp add: fun_eq_iff)
    54 
    54 
    55 section \<open>Setup for Numerals\<close>
    55 section \<open>Setup for Numerals\<close>
    56 
    56 
    57 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name numeral}]\<close>
    57 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>numeral\<close>]\<close>
    58 setup \<open>Predicate_Compile_Data.keep_functions [@{const_name numeral}]\<close>
    58 setup \<open>Predicate_Compile_Data.keep_functions [\<^const_name>\<open>numeral\<close>]\<close>
    59 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Char}]\<close>
    59 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Char\<close>]\<close>
    60 setup \<open>Predicate_Compile_Data.keep_functions [@{const_name Char}]\<close>
    60 setup \<open>Predicate_Compile_Data.keep_functions [\<^const_name>\<open>Char\<close>]\<close>
    61 
    61 
    62 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name divide}, @{const_name modulo}, @{const_name times}]\<close>
    62 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>divide\<close>, \<^const_name>\<open>modulo\<close>, \<^const_name>\<open>times\<close>]\<close>
    63 
    63 
    64 section \<open>Arithmetic operations\<close>
    64 section \<open>Arithmetic operations\<close>
    65 
    65 
    66 subsection \<open>Arithmetic on naturals and integers\<close>
    66 subsection \<open>Arithmetic on naturals and integers\<close>
    67 
    67 
    93   val Bool = Predicate_Compile_Aux.Bool
    93   val Bool = Predicate_Compile_Aux.Bool
    94   val iio = Fun (Input, Fun (Input, Fun (Output, Bool)))
    94   val iio = Fun (Input, Fun (Input, Fun (Output, Bool)))
    95   val ioi = Fun (Input, Fun (Output, Fun (Input, Bool)))
    95   val ioi = Fun (Input, Fun (Output, Fun (Input, Bool)))
    96   val oii = Fun (Output, Fun (Input, Fun (Input, Bool)))
    96   val oii = Fun (Output, Fun (Input, Fun (Input, Bool)))
    97   val ooi = Fun (Output, Fun (Output, Fun (Input, Bool)))
    97   val ooi = Fun (Output, Fun (Output, Fun (Input, Bool)))
    98   val plus_nat = Core_Data.functional_compilation @{const_name plus} iio
    98   val plus_nat = Core_Data.functional_compilation \<^const_name>\<open>plus\<close> iio
    99   val minus_nat = Core_Data.functional_compilation @{const_name "minus"} iio
    99   val minus_nat = Core_Data.functional_compilation \<^const_name>\<open>minus\<close> iio
   100   fun subtract_nat compfuns (_ : typ) =
   100   fun subtract_nat compfuns (_ : typ) =
   101     let
   101     let
   102       val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat}
   102       val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close>
   103     in
   103     in
   104       absdummy @{typ nat} (absdummy @{typ nat}
   104       absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close>
   105         (Const (@{const_name "If"}, @{typ bool} --> T --> T --> T) $
   105         (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $
   106           (@{term "(>) :: nat => nat => bool"} $ Bound 1 $ Bound 0) $
   106           (\<^term>\<open>(>) :: nat => nat => bool\<close> $ Bound 1 $ Bound 0) $
   107           Predicate_Compile_Aux.mk_empty compfuns @{typ nat} $
   107           Predicate_Compile_Aux.mk_empty compfuns \<^typ>\<open>nat\<close> $
   108           Predicate_Compile_Aux.mk_single compfuns
   108           Predicate_Compile_Aux.mk_single compfuns
   109           (@{term "(-) :: nat => nat => nat"} $ Bound 0 $ Bound 1)))
   109           (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 0 $ Bound 1)))
   110     end
   110     end
   111   fun enumerate_addups_nat compfuns (_ : typ) =
   111   fun enumerate_addups_nat compfuns (_ : typ) =
   112     absdummy @{typ nat} (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ "nat * nat"}
   112     absdummy \<^typ>\<open>nat\<close> (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat * nat\<close>
   113     (absdummy @{typ natural} (@{term "Pair :: nat => nat => nat * nat"} $
   113     (absdummy \<^typ>\<open>natural\<close> (\<^term>\<open>Pair :: nat => nat => nat * nat\<close> $
   114       (@{term "nat_of_natural"} $ Bound 0) $
   114       (\<^term>\<open>nat_of_natural\<close> $ Bound 0) $
   115       (@{term "(-) :: nat => nat => nat"} $ Bound 1 $ (@{term "nat_of_natural"} $ Bound 0))),
   115       (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 1 $ (\<^term>\<open>nat_of_natural\<close> $ Bound 0))),
   116       @{term "0 :: natural"}, @{term "natural_of_nat"} $ Bound 0))
   116       \<^term>\<open>0 :: natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 0))
   117   fun enumerate_nats compfuns  (_ : typ) =
   117   fun enumerate_nats compfuns  (_ : typ) =
   118     let
   118     let
   119       val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns @{term "0 :: nat"})
   119       val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns \<^term>\<open>0 :: nat\<close>)
   120       val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat}
   120       val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close>
   121     in
   121     in
   122       absdummy @{typ nat} (absdummy @{typ nat}
   122       absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close>
   123         (Const (@{const_name If}, @{typ bool} --> T --> T --> T) $
   123         (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $
   124           (@{term "(=) :: nat => nat => bool"} $ Bound 0 $ @{term "0::nat"}) $
   124           (\<^term>\<open>(=) :: nat => nat => bool\<close> $ Bound 0 $ \<^term>\<open>0::nat\<close>) $
   125           (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ nat} (@{term "nat_of_natural"},
   125           (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat\<close> (\<^term>\<open>nat_of_natural\<close>,
   126             @{term "0::natural"}, @{term "natural_of_nat"} $ Bound 1)) $
   126             \<^term>\<open>0::natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 1)) $
   127             (single_const $ (@{term "(+) :: nat => nat => nat"} $ Bound 1 $ Bound 0))))
   127             (single_const $ (\<^term>\<open>(+) :: nat => nat => nat\<close> $ Bound 1 $ Bound 0))))
   128     end
   128     end
   129 in
   129 in
   130   Core_Data.force_modes_and_compilations @{const_name plus_eq_nat}
   130   Core_Data.force_modes_and_compilations \<^const_name>\<open>plus_eq_nat\<close>
   131     [(iio, (plus_nat, false)), (oii, (subtract_nat, false)), (ioi, (subtract_nat, false)),
   131     [(iio, (plus_nat, false)), (oii, (subtract_nat, false)), (ioi, (subtract_nat, false)),
   132      (ooi, (enumerate_addups_nat, false))]
   132      (ooi, (enumerate_addups_nat, false))]
   133   #> Predicate_Compile_Fun.add_function_predicate_translation
   133   #> Predicate_Compile_Fun.add_function_predicate_translation
   134        (@{term "plus :: nat => nat => nat"}, @{term "plus_eq_nat"})
   134        (\<^term>\<open>plus :: nat => nat => nat\<close>, \<^term>\<open>plus_eq_nat\<close>)
   135   #> Core_Data.force_modes_and_compilations @{const_name minus_eq_nat}
   135   #> Core_Data.force_modes_and_compilations \<^const_name>\<open>minus_eq_nat\<close>
   136        [(iio, (minus_nat, false)), (oii, (enumerate_nats, false))]
   136        [(iio, (minus_nat, false)), (oii, (enumerate_nats, false))]
   137   #> Predicate_Compile_Fun.add_function_predicate_translation
   137   #> Predicate_Compile_Fun.add_function_predicate_translation
   138       (@{term "minus :: nat => nat => nat"}, @{term "minus_eq_nat"})
   138       (\<^term>\<open>minus :: nat => nat => nat\<close>, \<^term>\<open>minus_eq_nat\<close>)
   139   #> Core_Data.force_modes_and_functions @{const_name plus_eq_int}
   139   #> Core_Data.force_modes_and_functions \<^const_name>\<open>plus_eq_int\<close>
   140     [(iio, (@{const_name plus}, false)), (ioi, (@{const_name subtract}, false)),
   140     [(iio, (\<^const_name>\<open>plus\<close>, false)), (ioi, (\<^const_name>\<open>subtract\<close>, false)),
   141      (oii, (@{const_name subtract}, false))]
   141      (oii, (\<^const_name>\<open>subtract\<close>, false))]
   142   #> Predicate_Compile_Fun.add_function_predicate_translation
   142   #> Predicate_Compile_Fun.add_function_predicate_translation
   143        (@{term "plus :: int => int => int"}, @{term "plus_eq_int"})
   143        (\<^term>\<open>plus :: int => int => int\<close>, \<^term>\<open>plus_eq_int\<close>)
   144   #> Core_Data.force_modes_and_functions @{const_name minus_eq_int}
   144   #> Core_Data.force_modes_and_functions \<^const_name>\<open>minus_eq_int\<close>
   145     [(iio, (@{const_name minus}, false)), (oii, (@{const_name plus}, false)),
   145     [(iio, (\<^const_name>\<open>minus\<close>, false)), (oii, (\<^const_name>\<open>plus\<close>, false)),
   146      (ioi, (@{const_name minus}, false))]
   146      (ioi, (\<^const_name>\<open>minus\<close>, false))]
   147   #> Predicate_Compile_Fun.add_function_predicate_translation
   147   #> Predicate_Compile_Fun.add_function_predicate_translation
   148       (@{term "minus :: int => int => int"}, @{term "minus_eq_int"})
   148       (\<^term>\<open>minus :: int => int => int\<close>, \<^term>\<open>minus_eq_int\<close>)
   149 end
   149 end
   150 \<close>
   150 \<close>
   151 
   151 
   152 subsection \<open>Inductive definitions for ordering on naturals\<close>
   152 subsection \<open>Inductive definitions for ordering on naturals\<close>
   153 
   153 
   242   and (Haskell) "List.member_i_o"
   242   and (Haskell) "List.member_i_o"
   243   and (Scala) "List.member_i_o"
   243   and (Scala) "List.member_i_o"
   244 
   244 
   245 section \<open>Setup for String.literal\<close>
   245 section \<open>Setup for String.literal\<close>
   246 
   246 
   247 setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name String.Literal}]\<close>
   247 setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>String.Literal\<close>]\<close>
   248 
   248 
   249 section \<open>Simplification rules for optimisation\<close>
   249 section \<open>Simplification rules for optimisation\<close>
   250 
   250 
   251 lemma [code_pred_simp]: "\<not> False == True"
   251 lemma [code_pred_simp]: "\<not> False == True"
   252 by auto
   252 by auto