theory Demo6 = Main:

text {* Introducing new types *}

-- {* a new "undefined" type: *}
typedecl names  
consts blah :: names


-- {* simple abbreviation: *}
types 'a rel = "'a \<Rightarrow> 'a \<Rightarrow> bool"
constdefs 
  eq :: "'a rel"
  "eq x y \<equiv> (x = y)"


-- {* type definiton: pairs *}

typedef (prod) 
  ('a, 'b) prod = "{f. \<exists>a b. f = (\<lambda>(x::'a) (y::'b). x=a \<and> y=b)}"
  by blast
  
print_theorems 

constdefs 
  pair :: "'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) prod"
  "pair a b \<equiv> Abs_prod (\<lambda>x y. x = a \<and> y = b)"

constdefs
  fs :: "('a,'b) prod \<Rightarrow> 'a"
  "fs x \<equiv> SOME a. \<exists>b. x = pair a b"

  sn :: "('a,'b) prod \<Rightarrow> 'b"
  "sn x \<equiv> SOME b. \<exists>a. x = pair a b"

lemma in_prod: "(\<lambda>x y. x = a \<and> y = b) \<in> prod"
  apply (unfold prod_def)
  apply blast
  done

lemma pair_inject:
  "pair a b = pair a' b' \<Longrightarrow> a=a' \<and> b=b'"
  apply (unfold pair_def)
  thm Abs_prod_inject
  apply (insert in_prod [of a b])
  apply (insert in_prod [of a' b'])
  apply (blast dest: Abs_prod_inject fun_cong)
  done

lemma pair_eq:
  "(pair a b = pair a' b') = (a=a' \<and> b=b')"
  by (blast dest: pair_inject)

lemma fs:
  "fs (pair a b) = a"
  apply (unfold fs_def)
  apply (blast dest: pair_inject)
  done

lemma sn:
  "sn (pair a b) = b"
  apply (unfold sn_def)
  apply (blast dest: pair_inject)
  done


-- -----------------------------------------------------------

text {* Simplification *}


text {* 
Lists: 
  @{term "[]"}       empty list
  @{term "x#xs"}     cons (list with head x and tail xs)
  @{term "xs @ ys"}  append xs and ys
*}

lemma "ys @ [] = []"
apply(simp)
oops 

constdefs
  a :: "nat list"
  "a \<equiv> []"

  b :: "nat list"
  "b \<equiv> []"

text {* simp add, rewriting with definitions *}
lemma "xs @ a = xs"
  apply (simp add: a_def)
  done

text {* simp ony *}
lemma "xs @ a = xs"
  apply (simp only: a_def)
  apply simp
  done


lemma ab [simp]: "a = b" by (simp add: a_def b_def)
lemma ba [simp]: "b = a" by simp

text {* simp del, termination *}
lemma "a = []"
  (*
  apply (simp add: a_def)  
  does not terminate *)
  apply (simp add: a_def del: ab) 
  done


text{* Simple assumption: *}
lemma "xs = [] \<Longrightarrow> xs @ ys = ys @ xs @ ys"
  apply simp
  oops

text{* Simplification in assumption: *}
lemma "\<lbrakk> xs @ zs = ys @ xs; [] @ xs = [] @ [] \<rbrakk> \<Longrightarrow> ys = zs"
  apply simp
  done


-- ------------------------------------------------------------------

text {* Isar *}

lemma "\<lbrakk> A; B \<rbrakk> \<Longrightarrow> A \<and> B"
proof (rule conjI)
  assume A: "A"
  from A show "A" by assumption
next
  assume B: "B"
  from B show "B" by assumption
qed


lemma 
  assumes A: "A"
  assumes B: "B"
  shows "A \<and> B"
proof (rule conjI)
  from A show "A" by assumption
  from B show "B" by assumption
qed


lemma "(x::nat) + 1 = 1 + x"
proof -
  have A: "x + 1 = Suc x" by simp
  have B: "1 + x = Suc x" by simp
  show "x + 1 = 1 + x" by (simp only: A B)
qed
  

end