src/HOL/Isar_Examples/Nested_Datatype.thy
author wenzelm
Fri, 21 Feb 2014 18:23:11 +0100
changeset 55656 eb07b0acbebc
parent 37671 fa53d267dab3
child 58249 180f1b3508ed
permissions -rw-r--r--
more symbols;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
     1
header {* Nested datatypes *}
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
     2
31758
3edd5f813f01 observe standard theory naming conventions;
wenzelm
parents: 23373
diff changeset
     3
theory Nested_Datatype
3edd5f813f01 observe standard theory naming conventions;
wenzelm
parents: 23373
diff changeset
     4
imports Main
3edd5f813f01 observe standard theory naming conventions;
wenzelm
parents: 23373
diff changeset
     5
begin
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
     6
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
     7
subsection {* Terms and substitution *}
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
     8
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
     9
datatype ('a, 'b) "term" =
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    10
  Var 'a
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    11
| App 'b "('a, 'b) term list"
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    12
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    13
primrec subst_term :: "('a \<Rightarrow> ('a, 'b) term) \<Rightarrow> ('a, 'b) term \<Rightarrow> ('a, 'b) term"
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    14
  and subst_term_list :: "('a \<Rightarrow> ('a, 'b) term) \<Rightarrow> ('a, 'b) term list \<Rightarrow> ('a, 'b) term list"
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    15
where
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    16
  "subst_term f (Var a) = f a"
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    17
| "subst_term f (App b ts) = App b (subst_term_list f ts)"
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    18
| "subst_term_list f [] = []"
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    19
| "subst_term_list f (t # ts) = subst_term f t # subst_term_list f ts"
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    20
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    21
lemmas subst_simps = subst_term_subst_term_list.simps
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    22
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    23
text {* \medskip A simple lemma about composition of substitutions. *}
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    24
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    25
lemma
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    26
  "subst_term (subst_term f1 \<circ> f2) t =
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    27
    subst_term f1 (subst_term f2 t)"
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    28
  and
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    29
  "subst_term_list (subst_term f1 \<circ> f2) ts =
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    30
    subst_term_list f1 (subst_term_list f2 ts)"
11809
c9ffdd63dd93 tuned induction proofs;
wenzelm
parents: 10458
diff changeset
    31
  by (induct t and ts) simp_all
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    32
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    33
lemma "subst_term (subst_term f1 \<circ> f2) t =
37671
fa53d267dab3 misc tuning and modernization;
wenzelm
parents: 37597
diff changeset
    34
    subst_term f1 (subst_term f2 t)"
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    35
proof -
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    36
  let "?P t" = ?thesis
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    37
  let ?Q = "\<lambda>ts. subst_term_list (subst_term f1 \<circ> f2) ts =
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    38
    subst_term_list f1 (subst_term_list f2 ts)"
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    39
  show ?thesis
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    40
  proof (induct t)
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    41
    fix a show "?P (Var a)" by simp
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    42
  next
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    43
    fix b ts assume "?Q ts"
23373
ead82c82da9e tuned proofs: avoid implicit prems;
wenzelm
parents: 18460
diff changeset
    44
    then show "?P (App b ts)"
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    45
      by (simp only: subst_simps)
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    46
  next
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    47
    show "?Q []" by simp
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    48
  next
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    49
    fix t ts
23373
ead82c82da9e tuned proofs: avoid implicit prems;
wenzelm
parents: 18460
diff changeset
    50
    assume "?P t" "?Q ts" then show "?Q (t # ts)"
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    51
      by (simp only: subst_simps)
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    52
  qed
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    53
qed
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    54
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    55
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    56
subsection {* Alternative induction *}
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    57
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    58
theorem term_induct' [case_names Var App]:
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    59
  assumes var: "\<And>a. P (Var a)"
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    60
    and app: "\<And>b ts. (\<forall>t \<in> set ts. P t) \<Longrightarrow> P (App b ts)"
18153
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    61
  shows "P t"
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    62
proof (induct t)
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    63
  fix a show "P (Var a)" by (rule var)
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    64
next
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    65
  fix b t ts assume "\<forall>t \<in> set ts. P t"
23373
ead82c82da9e tuned proofs: avoid implicit prems;
wenzelm
parents: 18460
diff changeset
    66
  then show "P (App b ts)" by (rule app)
18153
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    67
next
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    68
  show "\<forall>t \<in> set []. P t" by simp
18153
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    69
next
37597
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    70
  fix t ts assume "P t" "\<forall>t' \<in> set ts. P t'"
a02ea93e88c6 modernized specifications
haftmann
parents: 33026
diff changeset
    71
  then show "\<forall>t' \<in> set (t # ts). P t'" by simp
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    72
qed
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    73
55656
eb07b0acbebc more symbols;
wenzelm
parents: 37671
diff changeset
    74
lemma "subst_term (subst_term f1 \<circ> f2) t = subst_term f1 (subst_term f2 t)"
11809
c9ffdd63dd93 tuned induction proofs;
wenzelm
parents: 10458
diff changeset
    75
proof (induct t rule: term_induct')
c9ffdd63dd93 tuned induction proofs;
wenzelm
parents: 10458
diff changeset
    76
  case (Var a)
18153
a084aa91f701 tuned proofs;
wenzelm
parents: 16417
diff changeset
    77
  show ?case by (simp add: o_def)
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    78
next
11809
c9ffdd63dd93 tuned induction proofs;
wenzelm
parents: 10458
diff changeset
    79
  case (App b ts)
23373
ead82c82da9e tuned proofs: avoid implicit prems;
wenzelm
parents: 18460
diff changeset
    80
  then show ?case by (induct ts) simp_all
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    81
qed
8676
4bf18b611a75 added NestedDatatype.thy;
wenzelm
parents:
diff changeset
    82
10007
64bf7da1994a isar-strip-terminators;
wenzelm
parents: 9659
diff changeset
    83
end