src/HOL/Nominal/Examples/VC_Condition.thy
author urbanc
Tue, 01 Jan 2008 07:28:20 +0100
changeset 25751 a4e69ce247e0
parent 25727 e43d91f31118
child 25867 c24395ea4e71
permissions -rw-r--r--
tuned proofs and comments
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     1
(* $Id$ *)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     2
25727
e43d91f31118 adapted theory name;
wenzelm
parents: 25722
diff changeset
     3
theory VC_Condition
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     4
imports "../Nominal" 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     5
begin
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     6
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     7
text {* 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     8
  We give here two examples that show if we use the variable  
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
     9
  convention carelessly in rule inductions, we might end 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    10
  up with faulty lemmas. The point is that the examples
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    11
  are not variable-convention compatible and therefore in the 
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    12
  nominal data package one is protected from such bogus reasoning.
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    13
*}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    14
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    15
text {* We define alpha-equated lambda-terms as usual. *}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    16
atom_decl name 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    17
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    18
nominal_datatype lam = 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    19
    Var "name"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    20
  | App "lam" "lam"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    21
  | Lam "\<guillemotleft>name\<guillemotright>lam" ("Lam [_]._" [100,100] 100)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    22
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    23
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    24
  The inductive relation 'unbind' unbinds the top-most  
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    25
  binders of a lambda-term; this relation is obviously  
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    26
  not a function, since it does not respect alpha-      
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    27
  equivalence. However as a relation 'unbind' is ok and     
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    28
  a similar relation has been used in our formalisation 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    29
  of the algorithm W. *}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    30
inductive
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    31
  unbind :: "lam \<Rightarrow> name list \<Rightarrow> lam \<Rightarrow> bool" ("_ \<mapsto> _,_" [60,60,60] 60)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    32
where
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    33
  u_var: "(Var a) \<mapsto> [],(Var a)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    34
| u_app: "(App t1 t2) \<mapsto> [],(App t1 t2)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    35
| u_lam: "t\<mapsto>xs,t' \<Longrightarrow> (Lam [x].t) \<mapsto> (x#xs),t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    36
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    37
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    38
  We can show that Lam [x].Lam [x].Var x unbinds to [x,x],Var x 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    39
  and also to [z,y],Var y (though the proof for the second is a 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    40
  bit clumsy). *} 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    41
lemma unbind_lambda_lambda1: 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    42
  shows "Lam [x].Lam [x].(Var x)\<mapsto>[x,x],(Var x)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    43
by (auto intro: unbind.intros)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    44
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    45
lemma unbind_lambda_lambda2: 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    46
  shows "Lam [x].Lam [x].(Var x)\<mapsto>[y,z],(Var z)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    47
proof -
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    48
  have "Lam [x].Lam [x].(Var x) = Lam [y].Lam [z].(Var z)" 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    49
    by (auto simp add: lam.inject alpha calc_atm abs_fresh fresh_atm)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    50
  moreover
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    51
  have "Lam [y].Lam [z].(Var z) \<mapsto> [y,z],(Var z)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    52
    by (auto intro: unbind.intros)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    53
  ultimately 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    54
  show "Lam [x].Lam [x].(Var x)\<mapsto>[y,z],(Var z)" by simp
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    55
qed
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    56
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    57
text {* Unbind is equivariant ...*}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    58
equivariance unbind
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    59
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    60
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    61
  ... but it is not variable-convention compatible (see Urban, 
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    62
  Berghofer, Norrish [2007]). This condition requires for rule u_lam to 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    63
  have the binder x not being a free variable in this rule's conclusion. 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    64
  Because this condition is not satisfied, Isabelle will not derive a 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    65
  strong induction principle for 'unbind' - that means Isabelle does not 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    66
  allow us to use the variable convention in induction proofs over 'unbind'. 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    67
  We can, however, force Isabelle to derive the strengthening induction 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    68
  principle and see what happens. *}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    69
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    70
nominal_inductive unbind
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    71
  sorry
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    72
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    73
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    74
  To obtain a faulty lemma, we introduce the function 'bind'
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
    75
  which takes a list of names and abstracts them away in 
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    76
  a given lambda-term. *}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    77
fun 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    78
  bind :: "name list \<Rightarrow> lam \<Rightarrow> lam"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    79
where
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    80
  "bind [] t = t"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    81
| "bind (x#xs) t = Lam [x].(bind xs t)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    82
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    83
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    84
  Although not necessary for our main argument below, we can 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    85
  easily prove that bind undoes the unbinding. *}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    86
lemma bind_unbind:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    87
  assumes a: "t \<mapsto> xs,t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    88
  shows "t = bind xs t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    89
using a by (induct) (auto)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    90
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    91
text {*
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    92
  The next lemma shows by induction on xs that if x is a free 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    93
  variable in t and x does not occur in xs, then x is a free 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    94
  variable in bind xs t. In the nominal tradition we formulate    
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    95
  'is a free variable in' as 'is not fresh for'. *}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    96
lemma free_variable:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    97
  fixes x::"name"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    98
  assumes a: "\<not>(x\<sharp>t)" and b: "x\<sharp>xs"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
    99
  shows "\<not>(x\<sharp>bind xs t)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   100
using a b
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   101
by (induct xs)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   102
   (auto simp add: fresh_list_cons abs_fresh fresh_atm)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   103
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   104
text {*
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   105
  Now comes the first faulty lemma. It is derived using the     
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   106
  variable convention (i.e. our strong induction principle). 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   107
  This faulty lemma states that if t unbinds to x::xs and t', 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   108
  and x is a free variable in t', then it is also a free 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   109
  variable in bind xs t'. We show this lemma by assuming that 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   110
  the binder x is fresh w.r.t. to the xs unbound previously. *}   
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   111
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   112
lemma faulty1:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   113
  assumes a: "t\<mapsto>(x#xs),t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   114
  shows "\<not>(x\<sharp>t') \<Longrightarrow> \<not>(x\<sharp>bind xs t')"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   115
using a
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   116
by (nominal_induct t xs'\<equiv>"x#xs" t' avoiding: xs rule: unbind.strong_induct)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   117
   (simp_all add: free_variable)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   118
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   119
text {*
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   120
  Obviously this lemma is bogus. For example, in 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   121
  case Lam [x].Lam [x].(Var x) \<mapsto> [x,x],(Var x). 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   122
  As a result, we can prove False. 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   123
*}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   124
lemma false1:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   125
  shows "False"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   126
proof -
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   127
  have "Lam [x].Lam [x].(Var x)\<mapsto>[x,x],(Var x)" 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   128
  and  "\<not>(x\<sharp>Var x)" by (simp_all add: unbind_lambda_lambda1 fresh_atm)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   129
  then have "\<not>(x\<sharp>(bind [x] (Var x)))" by (rule faulty1)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   130
  moreover 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   131
  have "x\<sharp>(bind [x] (Var x))" by (simp add: abs_fresh)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   132
  ultimately
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   133
  show "False" by simp
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   134
qed
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   135
   
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   136
text {* 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   137
  The next example is slightly simpler, but looks more
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   138
  contrived than 'unbind'. This example, called 'strip' just 
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   139
  strips off the top-most binders from lambdas. *}
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   140
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   141
inductive
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   142
  strip :: "lam \<Rightarrow> lam \<Rightarrow> bool" ("_ \<rightarrow> _" [60,60] 60)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   143
where
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   144
  s_var: "(Var a) \<rightarrow> (Var a)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   145
| s_app: "(App t1 t2) \<rightarrow> (App t1 t2)"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   146
| s_lam: "t \<rightarrow> t' \<Longrightarrow> (Lam [x].t) \<rightarrow> t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   147
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   148
text {* 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   149
  The relation is equivariant but we have to use again 
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   150
  sorry to derive a strong induction principle. 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   151
*}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   152
equivariance strip
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   153
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   154
nominal_inductive strip
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   155
  sorry
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   156
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   157
text {*
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   158
  The second faulty lemma shows that a variable being fresh
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   159
  for a term is also fresh for this term after striping. 
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   160
*}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   161
lemma faulty2:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   162
  fixes x::"name"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   163
  assumes a: "t \<rightarrow> t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   164
  shows "x\<sharp>t \<Longrightarrow> x\<sharp>t'"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   165
using a
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   166
by (nominal_induct t t'\<equiv>t' avoiding: t' rule: strip.strong_induct)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   167
   (auto simp add: abs_fresh)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   168
25751
a4e69ce247e0 tuned proofs and comments
urbanc
parents: 25727
diff changeset
   169
text {* Obviously Lam [x].Var x is a counter example to this lemma. *}
25722
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   170
lemma false2:
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   171
  shows "False"
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   172
proof -
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   173
  have "Lam [x].(Var x) \<rightarrow> (Var x)" by (auto intro: strip.intros)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   174
  moreover
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   175
  have "x\<sharp>Lam [x].(Var x)" by (simp add: abs_fresh)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   176
  ultimately have "x\<sharp>(Var x)" by (simp only: faulty2)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   177
  then show "False" by (simp add: fresh_atm)
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   178
qed 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   179
 
0a104ddb72d9 polishing of some proofs
urbanc
parents:
diff changeset
   180
end