src/HOL/Product_Type.thy
changeset 37389 09467cdfa198
parent 37387 3581483cca6c
child 37411 c88c44156083
equal deleted inserted replaced
37388:793618618f78 37389:09467cdfa198
     7 
     7 
     8 theory Product_Type
     8 theory Product_Type
     9 imports Typedef Inductive Fun
     9 imports Typedef Inductive Fun
    10 uses
    10 uses
    11   ("Tools/split_rule.ML")
    11   ("Tools/split_rule.ML")
       
    12   ("Tools/inductive_codegen.ML")
    12   ("Tools/inductive_set.ML")
    13   ("Tools/inductive_set.ML")
    13 begin
    14 begin
    14 
    15 
    15 subsection {* @{typ bool} is a datatype *}
    16 subsection {* @{typ bool} is a datatype *}
    16 
    17 
   126 subsubsection {* Type definition *}
   127 subsubsection {* Type definition *}
   127 
   128 
   128 definition Pair_Rep :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool" where
   129 definition Pair_Rep :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool" where
   129   "Pair_Rep a b = (\<lambda>x y. x = a \<and> y = b)"
   130   "Pair_Rep a b = (\<lambda>x y. x = a \<and> y = b)"
   130 
   131 
   131 global
   132 typedef (prod) ('a, 'b) "*" (infixr "*" 20)
   132 
   133   = "{f. \<exists>a b. f = Pair_Rep (a\<Colon>'a) (b\<Colon>'b)}"
   133 typedef (Prod)
       
   134   ('a, 'b) "*"    (infixr "*" 20)
       
   135     = "{f. \<exists>a b. f = Pair_Rep (a\<Colon>'a) (b\<Colon>'b)}"
       
   136 proof
   134 proof
   137   fix a b show "Pair_Rep a b \<in> ?Prod"
   135   fix a b show "Pair_Rep a b \<in> ?prod"
   138     by rule+
   136     by rule+
   139 qed
   137 qed
   140 
   138 
   141 type_notation (xsymbols)
   139 type_notation (xsymbols)
   142   "*"  ("(_ \<times>/ _)" [21, 20] 20)
   140   "*"  ("(_ \<times>/ _)" [21, 20] 20)
   143 type_notation (HTML output)
   141 type_notation (HTML output)
   144   "*"  ("(_ \<times>/ _)" [21, 20] 20)
   142   "*"  ("(_ \<times>/ _)" [21, 20] 20)
   145 
   143 
   146 consts
   144 definition Pair :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<times> 'b" where
   147   Pair     :: "'a \<Rightarrow> 'b \<Rightarrow> 'a \<times> 'b"
   145   "Pair a b = Abs_prod (Pair_Rep a b)"
   148 
       
   149 local
       
   150 
       
   151 defs
       
   152   Pair_def:     "Pair a b == Abs_Prod (Pair_Rep a b)"
       
   153 
   146 
   154 rep_datatype (prod) Pair proof -
   147 rep_datatype (prod) Pair proof -
   155   fix P :: "'a \<times> 'b \<Rightarrow> bool" and p
   148   fix P :: "'a \<times> 'b \<Rightarrow> bool" and p
   156   assume "\<And>a b. P (Pair a b)"
   149   assume "\<And>a b. P (Pair a b)"
   157   then show "P p" by (cases p) (auto simp add: Prod_def Pair_def Pair_Rep_def)
   150   then show "P p" by (cases p) (auto simp add: prod_def Pair_def Pair_Rep_def)
   158 next
   151 next
   159   fix a c :: 'a and b d :: 'b
   152   fix a c :: 'a and b d :: 'b
   160   have "Pair_Rep a b = Pair_Rep c d \<longleftrightarrow> a = c \<and> b = d"
   153   have "Pair_Rep a b = Pair_Rep c d \<longleftrightarrow> a = c \<and> b = d"
   161     by (auto simp add: Pair_Rep_def expand_fun_eq)
   154     by (auto simp add: Pair_Rep_def expand_fun_eq)
   162   moreover have "Pair_Rep a b \<in> Prod" and "Pair_Rep c d \<in> Prod"
   155   moreover have "Pair_Rep a b \<in> prod" and "Pair_Rep c d \<in> prod"
   163     by (auto simp add: Prod_def)
   156     by (auto simp add: prod_def)
   164   ultimately show "Pair a b = Pair c d \<longleftrightarrow> a = c \<and> b = d"
   157   ultimately show "Pair a b = Pair c d \<longleftrightarrow> a = c \<and> b = d"
   165     by (simp add: Pair_def Abs_Prod_inject)
   158     by (simp add: Pair_def Abs_prod_inject)
   166 qed
   159 qed
   167 
   160 
   168 
   161 
   169 subsubsection {* Tuple syntax *}
   162 subsubsection {* Tuple syntax *}
   170 
   163 
   171 global consts
   164 definition split :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
   172   split    :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c"
       
   173 
       
   174 local defs
       
   175   split_prod_case: "split == prod_case"
   165   split_prod_case: "split == prod_case"
   176 
   166 
   177 text {*
   167 text {*
   178   Patterns -- extends pre-defined type @{typ pttrn} used in
   168   Patterns -- extends pre-defined type @{typ pttrn} used in
   179   abstractions.
   169   abstractions.
   391 subsubsection {* Fundamental operations and properties *}
   381 subsubsection {* Fundamental operations and properties *}
   392 
   382 
   393 lemma surj_pair [simp]: "EX x y. p = (x, y)"
   383 lemma surj_pair [simp]: "EX x y. p = (x, y)"
   394   by (cases p) simp
   384   by (cases p) simp
   395 
   385 
   396 global consts
   386 definition fst :: "'a \<times> 'b \<Rightarrow> 'a" where
   397   fst      :: "'a \<times> 'b \<Rightarrow> 'a"
   387   "fst p = (case p of (a, b) \<Rightarrow> a)"
   398   snd      :: "'a \<times> 'b \<Rightarrow> 'b"
   388 
   399 
   389 definition snd :: "'a \<times> 'b \<Rightarrow> 'b" where
   400 local defs
   390   "snd p = (case p of (a, b) \<Rightarrow> b)"
   401   fst_def:      "fst p == case p of (a, b) \<Rightarrow> a"
       
   402   snd_def:      "snd p == case p of (a, b) \<Rightarrow> b"
       
   403 
   391 
   404 lemma fst_conv [simp, code]: "fst (a, b) = a"
   392 lemma fst_conv [simp, code]: "fst (a, b) = a"
   405   unfolding fst_def by simp
   393   unfolding fst_def by simp
   406 
   394 
   407 lemma snd_conv [simp, code]: "snd (a, b) = b"
   395 lemma snd_conv [simp, code]: "snd (a, b) = b"
  1187 qed simp_all
  1175 qed simp_all
  1188 
  1176 
  1189 
  1177 
  1190 subsection {* Inductively defined sets *}
  1178 subsection {* Inductively defined sets *}
  1191 
  1179 
       
  1180 use "Tools/inductive_codegen.ML"
       
  1181 setup Inductive_Codegen.setup
       
  1182 
  1192 use "Tools/inductive_set.ML"
  1183 use "Tools/inductive_set.ML"
  1193 setup Inductive_Set.setup
  1184 setup Inductive_Set.setup
  1194 
  1185 
  1195 
  1186 
  1196 subsection {* Legacy theorem bindings and duplicates *}
  1187 subsection {* Legacy theorem bindings and duplicates *}