src/HOL/Induct/QuoNestedDataType.thy
changeset 23746 a455e69c31cc
parent 22269 7c1e65897693
child 30198 922f944f03b2
equal deleted inserted replaced
23745:28df61d931e2 23746:a455e69c31cc
    16      freeExp = VAR  nat
    16      freeExp = VAR  nat
    17 	     | PLUS  freeExp freeExp
    17 	     | PLUS  freeExp freeExp
    18 	     | FNCALL  nat "freeExp list"
    18 	     | FNCALL  nat "freeExp list"
    19 
    19 
    20 text{*The equivalence relation, which makes PLUS associative.*}
    20 text{*The equivalence relation, which makes PLUS associative.*}
    21 consts  exprel :: "(freeExp * freeExp) set"
       
    22 
       
    23 abbreviation
       
    24   exp_rel :: "[freeExp, freeExp] => bool"  (infixl "~~" 50) where
       
    25   "X ~~ Y == (X,Y) \<in> exprel"
       
    26 
       
    27 notation (xsymbols)
       
    28   exp_rel  (infixl "\<sim>" 50)
       
    29 notation (HTML output)
       
    30   exp_rel  (infixl "\<sim>" 50)
       
    31 
    21 
    32 text{*The first rule is the desired equation. The next three rules
    22 text{*The first rule is the desired equation. The next three rules
    33 make the equations applicable to subterms. The last two rules are symmetry
    23 make the equations applicable to subterms. The last two rules are symmetry
    34 and transitivity.*}
    24 and transitivity.*}
    35 inductive "exprel"
    25 inductive_set
    36   intros 
    26   exprel :: "(freeExp * freeExp) set"
    37     ASSOC: "PLUS X (PLUS Y Z) \<sim> PLUS (PLUS X Y) Z"
    27   and exp_rel :: "[freeExp, freeExp] => bool"  (infixl "\<sim>" 50)
    38     VAR: "VAR N \<sim> VAR N"
    28   where
    39     PLUS: "\<lbrakk>X \<sim> X'; Y \<sim> Y'\<rbrakk> \<Longrightarrow> PLUS X Y \<sim> PLUS X' Y'"
    29     "X \<sim> Y == (X,Y) \<in> exprel"
    40     FNCALL: "(Xs,Xs') \<in> listrel exprel \<Longrightarrow> FNCALL F Xs \<sim> FNCALL F Xs'"
    30   | ASSOC: "PLUS X (PLUS Y Z) \<sim> PLUS (PLUS X Y) Z"
    41     SYM:   "X \<sim> Y \<Longrightarrow> Y \<sim> X"
    31   | VAR: "VAR N \<sim> VAR N"
    42     TRANS: "\<lbrakk>X \<sim> Y; Y \<sim> Z\<rbrakk> \<Longrightarrow> X \<sim> Z"
    32   | PLUS: "\<lbrakk>X \<sim> X'; Y \<sim> Y'\<rbrakk> \<Longrightarrow> PLUS X Y \<sim> PLUS X' Y'"
       
    33   | FNCALL: "(Xs,Xs') \<in> listrel exprel \<Longrightarrow> FNCALL F Xs \<sim> FNCALL F Xs'"
       
    34   | SYM:   "X \<sim> Y \<Longrightarrow> Y \<sim> X"
       
    35   | TRANS: "\<lbrakk>X \<sim> Y; Y \<sim> Z\<rbrakk> \<Longrightarrow> X \<sim> Z"
    43   monos listrel_mono
    36   monos listrel_mono
    44 
    37 
    45 
    38 
    46 text{*Proving that it is an equivalence relation*}
    39 text{*Proving that it is an equivalence relation*}
    47 
    40 
    48 lemma exprel_refl: "X \<sim> X"
    41 lemma exprel_refl: "X \<sim> X"
    49   and list_exprel_refl: "(Xs,Xs) \<in> listrel(exprel)"
    42   and list_exprel_refl: "(Xs,Xs) \<in> listrel(exprel)"
    50   by (induct X and Xs) (blast intro: exprel.intros listrel_intros)+
    43   by (induct X and Xs) (blast intro: exprel.intros listrel.intros)+
    51 
    44 
    52 theorem equiv_exprel: "equiv UNIV exprel"
    45 theorem equiv_exprel: "equiv UNIV exprel"
    53 proof -
    46 proof -
    54   have "reflexive exprel" by (simp add: refl_def exprel_refl)
    47   have "reflexive exprel" by (simp add: refl_def exprel_refl)
    55   moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM)
    48   moreover have "sym exprel" by (simp add: sym_def, blast intro: exprel.SYM)
    61   using equiv_listrel [OF equiv_exprel] by simp
    54   using equiv_listrel [OF equiv_exprel] by simp
    62 
    55 
    63 
    56 
    64 lemma FNCALL_Nil: "FNCALL F [] \<sim> FNCALL F []"
    57 lemma FNCALL_Nil: "FNCALL F [] \<sim> FNCALL F []"
    65 apply (rule exprel.intros) 
    58 apply (rule exprel.intros) 
    66 apply (rule listrel_intros) 
    59 apply (rule listrel.intros) 
    67 done
    60 done
    68 
    61 
    69 lemma FNCALL_Cons:
    62 lemma FNCALL_Cons:
    70      "\<lbrakk>X \<sim> X'; (Xs,Xs') \<in> listrel(exprel)\<rbrakk>
    63      "\<lbrakk>X \<sim> X'; (Xs,Xs') \<in> listrel(exprel)\<rbrakk>
    71       \<Longrightarrow> FNCALL F (X#Xs) \<sim> FNCALL F (X'#Xs')"
    64       \<Longrightarrow> FNCALL F (X#Xs) \<sim> FNCALL F (X'#Xs')"
    72 by (blast intro: exprel.intros listrel_intros) 
    65 by (blast intro: exprel.intros listrel.intros) 
    73 
    66 
    74 
    67 
    75 
    68 
    76 subsection{*Some Functions on the Free Algebra*}
    69 subsection{*Some Functions on the Free Algebra*}
    77 
    70 
    96 text{*This theorem lets us prove that the vars function respects the
    89 text{*This theorem lets us prove that the vars function respects the
    97 equivalence relation.  It also helps us prove that Variable
    90 equivalence relation.  It also helps us prove that Variable
    98   (the abstract constructor) is injective*}
    91   (the abstract constructor) is injective*}
    99 theorem exprel_imp_eq_freevars: "U \<sim> V \<Longrightarrow> freevars U = freevars V"
    92 theorem exprel_imp_eq_freevars: "U \<sim> V \<Longrightarrow> freevars U = freevars V"
   100 apply (induct set: exprel) 
    93 apply (induct set: exprel) 
   101 apply (erule_tac [4] listrel_induct) 
    94 apply (erule_tac [4] listrel.induct) 
   102 apply (simp_all add: Un_assoc)
    95 apply (simp_all add: Un_assoc)
   103 done
    96 done
   104 
    97 
   105 
    98 
   106 
    99 
   127    "freefun (PLUS X Y) = 0"
   120    "freefun (PLUS X Y) = 0"
   128    "freefun (FNCALL F Xs) = F"
   121    "freefun (FNCALL F Xs) = F"
   129 
   122 
   130 theorem exprel_imp_eq_freefun:
   123 theorem exprel_imp_eq_freefun:
   131      "U \<sim> V \<Longrightarrow> freefun U = freefun V"
   124      "U \<sim> V \<Longrightarrow> freefun U = freefun V"
   132   by (induct set: exprel) (simp_all add: listrel_intros)
   125   by (induct set: exprel) (simp_all add: listrel.intros)
   133 
   126 
   134 
   127 
   135 text{*This function, which returns the list of function arguments, is used to
   128 text{*This function, which returns the list of function arguments, is used to
   136 prove part of the injectivity property for FnCall.*}
   129 prove part of the injectivity property for FnCall.*}
   137 consts  freeargs      :: "freeExp \<Rightarrow> freeExp list"
   130 consts  freeargs      :: "freeExp \<Rightarrow> freeExp list"
   141    "freeargs (FNCALL F Xs) = Xs"
   134    "freeargs (FNCALL F Xs) = Xs"
   142 
   135 
   143 theorem exprel_imp_eqv_freeargs:
   136 theorem exprel_imp_eqv_freeargs:
   144      "U \<sim> V \<Longrightarrow> (freeargs U, freeargs V) \<in> listrel exprel"
   137      "U \<sim> V \<Longrightarrow> (freeargs U, freeargs V) \<in> listrel exprel"
   145 apply (induct set: exprel)
   138 apply (induct set: exprel)
   146 apply (erule_tac [4] listrel_induct) 
   139 apply (erule_tac [4] listrel.induct) 
   147 apply (simp_all add: listrel_intros)
   140 apply (simp_all add: listrel.intros)
   148 apply (blast intro: symD [OF equiv.sym [OF equiv_list_exprel]])
   141 apply (blast intro: symD [OF equiv.sym [OF equiv_list_exprel]])
   149 apply (blast intro: transD [OF equiv.trans [OF equiv_list_exprel]])
   142 apply (blast intro: transD [OF equiv.trans [OF equiv_list_exprel]])
   150 done
   143 done
   151 
   144 
   152 
   145 
   256 
   249 
   257 lemma FnCall_sing:
   250 lemma FnCall_sing:
   258      "FnCall F [Abs_Exp(exprel``{U})] = Abs_Exp (exprel``{FNCALL F [U]})"
   251      "FnCall F [Abs_Exp(exprel``{U})] = Abs_Exp (exprel``{FNCALL F [U]})"
   259 proof -
   252 proof -
   260   have "(\<lambda>U. exprel `` {FNCALL F [U]}) respects exprel"
   253   have "(\<lambda>U. exprel `` {FNCALL F [U]}) respects exprel"
   261     by (simp add: congruent_def FNCALL_Cons listrel_intros)
   254     by (simp add: congruent_def FNCALL_Cons listrel.intros)
   262   thus ?thesis
   255   thus ?thesis
   263     by (simp add: FnCall_def UN_equiv_class [OF equiv_exprel])
   256     by (simp add: FnCall_def UN_equiv_class [OF equiv_exprel])
   264 qed
   257 qed
   265 
   258 
   266 lemma listset_Rep_Exp_Abs_Exp:
   259 lemma listset_Rep_Exp_Abs_Exp: