wenzelm@18400: (* Title: HOL/Library/Coinductive_Lists.thy wenzelm@18400: ID: $Id$ wenzelm@18400: Author: Lawrence C Paulson and Makarius wenzelm@18400: *) wenzelm@18400: wenzelm@18400: header {* Potentially infinite lists as greatest fixed-point *} wenzelm@18400: wenzelm@18400: theory Coinductive_List wenzelm@18400: imports Main wenzelm@18400: begin wenzelm@18400: wenzelm@18400: subsection {* List constructors over the datatype universe *} wenzelm@18400: wenzelm@19086: definition wenzelm@20820: "NIL = Datatype.In0 (Datatype.Numb 0)" wenzelm@21404: definition wenzelm@20820: "CONS M N = Datatype.In1 (Datatype.Scons M N)" wenzelm@18400: wenzelm@18400: lemma CONS_not_NIL [iff]: "CONS M N \ NIL" wenzelm@18400: and NIL_not_CONS [iff]: "NIL \ CONS M N" wenzelm@18400: and CONS_inject [iff]: "(CONS K M) = (CONS L N) = (K = L \ M = N)" wenzelm@18400: by (simp_all add: NIL_def CONS_def) wenzelm@18400: wenzelm@18400: lemma CONS_mono: "M \ M' \ N \ N' \ CONS M N \ CONS M' N'" wenzelm@18400: by (simp add: CONS_def In1_mono Scons_mono) wenzelm@18400: wenzelm@18400: lemma CONS_UN1: "CONS M (\x. f x) = (\x. CONS M (f x))" wenzelm@18400: -- {* A continuity result? *} wenzelm@18400: by (simp add: CONS_def In1_UN1 Scons_UN1_y) wenzelm@18400: wenzelm@19086: definition wenzelm@20820: "List_case c h = Datatype.Case (\_. c) (Datatype.Split h)" wenzelm@18400: wenzelm@18400: lemma List_case_NIL [simp]: "List_case c h NIL = c" wenzelm@18400: and List_case_CONS [simp]: "List_case c h (CONS M N) = h M N" wenzelm@18400: by (simp_all add: List_case_def NIL_def CONS_def) wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection {* Corecursive lists *} wenzelm@18400: wenzelm@18400: consts wenzelm@20820: LList :: "'a Datatype.item set \ 'a Datatype.item set" wenzelm@18400: wenzelm@18400: coinductive "LList A" wenzelm@18400: intros wenzelm@18400: NIL [intro]: "NIL \ LList A" wenzelm@18400: CONS [intro]: "a \ A \ M \ LList A \ CONS a M \ LList A" wenzelm@18400: wenzelm@18400: lemma LList_mono: "A \ B \ LList A \ LList B" wenzelm@18400: -- {* This justifies using @{text LList} in other recursive type definitions. *} wenzelm@18730: unfolding LList.defs by (blast intro!: gfp_mono) wenzelm@18400: wenzelm@18400: consts wenzelm@20820: LList_corec_aux :: "nat \ ('a \ ('b Datatype.item \ 'a) option) \ wenzelm@20820: 'a \ 'b Datatype.item" wenzelm@18400: primrec wenzelm@18400: "LList_corec_aux 0 f x = {}" wenzelm@18400: "LList_corec_aux (Suc k) f x = wenzelm@18400: (case f x of wenzelm@18400: None \ NIL wenzelm@18400: | Some (z, w) \ CONS z (LList_corec_aux k f w))" wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "LList_corec a f = (\k. LList_corec_aux k f a)" wenzelm@18400: wenzelm@18400: text {* wenzelm@18400: Note: the subsequent recursion equation for @{text LList_corec} may wenzelm@18400: be used with the Simplifier, provided it operates in a non-strict wenzelm@18400: fashion for case expressions (i.e.\ the usual @{text case} wenzelm@18400: congruence rule needs to be present). wenzelm@18400: *} wenzelm@18400: wenzelm@18400: lemma LList_corec: wenzelm@18400: "LList_corec a f = wenzelm@18400: (case f a of None \ NIL | Some (z, w) \ CONS z (LList_corec w f))" wenzelm@18400: (is "?lhs = ?rhs") wenzelm@18400: proof wenzelm@18400: show "?lhs \ ?rhs" wenzelm@18400: apply (unfold LList_corec_def) wenzelm@18400: apply (rule UN_least) wenzelm@18400: apply (case_tac k) wenzelm@18400: apply (simp_all (no_asm_simp) split: option.splits) wenzelm@18400: apply (rule allI impI subset_refl [THEN CONS_mono] UNIV_I [THEN UN_upper])+ wenzelm@18400: done wenzelm@18400: show "?rhs \ ?lhs" wenzelm@18400: apply (simp add: LList_corec_def split: option.splits) wenzelm@18400: apply (simp add: CONS_UN1) wenzelm@18400: apply safe wenzelm@18400: apply (rule_tac a = "Suc ?k" in UN_I, simp, simp)+ wenzelm@18400: done wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma LList_corec_type: "LList_corec a f \ LList UNIV" wenzelm@18400: proof - wenzelm@18400: have "LList_corec a f \ {LList_corec a f | a. True}" by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof coinduct wenzelm@18400: case (LList L) wenzelm@18400: then obtain x where L: "L = LList_corec x f" by blast wenzelm@18400: show ?case wenzelm@18400: proof (cases "f x") wenzelm@18400: case None wenzelm@18400: then have "LList_corec x f = NIL" wenzelm@18400: by (simp add: LList_corec) wenzelm@18400: with L have ?NIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case (Some p) wenzelm@18400: then have "LList_corec x f = CONS (fst p) (LList_corec (snd p) f)" wenzelm@18400: by (simp add: split_def LList_corec) wenzelm@18400: with L have ?CONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection {* Abstract type definition *} wenzelm@18400: wenzelm@18400: typedef 'a llist = wenzelm@20820: "LList (range Datatype.Leaf) :: 'a Datatype.item set" wenzelm@18400: proof wenzelm@18400: show "NIL \ ?llist" .. wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma NIL_type: "NIL \ llist" wenzelm@18730: unfolding llist_def by (rule LList.NIL) wenzelm@18400: wenzelm@20820: lemma CONS_type: "a \ range Datatype.Leaf \ wenzelm@18400: M \ llist \ CONS a M \ llist" wenzelm@18730: unfolding llist_def by (rule LList.CONS) wenzelm@18400: wenzelm@20820: lemma llistI: "x \ LList (range Datatype.Leaf) \ x \ llist" wenzelm@18400: by (simp add: llist_def) wenzelm@18400: wenzelm@20820: lemma llistD: "x \ llist \ x \ LList (range Datatype.Leaf)" wenzelm@18400: by (simp add: llist_def) wenzelm@18400: wenzelm@18400: lemma Rep_llist_UNIV: "Rep_llist x \ LList UNIV" wenzelm@18400: proof - wenzelm@18400: have "Rep_llist x \ llist" by (rule Rep_llist) wenzelm@20820: then have "Rep_llist x \ LList (range Datatype.Leaf)" wenzelm@18400: by (simp add: llist_def) wenzelm@18400: also have "\ \ LList UNIV" by (rule LList_mono) simp wenzelm@18400: finally show ?thesis . wenzelm@18400: qed wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "LNil = Abs_llist NIL" wenzelm@21404: definition wenzelm@20820: "LCons x xs = Abs_llist (CONS (Datatype.Leaf x) (Rep_llist xs))" wenzelm@18400: wenzelm@18400: lemma LCons_not_LNil [iff]: "LCons x xs \ LNil" wenzelm@18400: apply (simp add: LNil_def LCons_def) wenzelm@18400: apply (subst Abs_llist_inject) wenzelm@18400: apply (auto intro: NIL_type CONS_type Rep_llist) wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma LNil_not_LCons [iff]: "LNil \ LCons x xs" wenzelm@18400: by (rule LCons_not_LNil [symmetric]) wenzelm@18400: wenzelm@18400: lemma LCons_inject [iff]: "(LCons x xs = LCons y ys) = (x = y \ xs = ys)" wenzelm@18400: apply (simp add: LCons_def) wenzelm@18400: apply (subst Abs_llist_inject) wenzelm@18400: apply (auto simp add: Rep_llist_inject intro: CONS_type Rep_llist) wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma Rep_llist_LNil: "Rep_llist LNil = NIL" wenzelm@18400: by (simp add: LNil_def add: Abs_llist_inverse NIL_type) wenzelm@18400: wenzelm@18400: lemma Rep_llist_LCons: "Rep_llist (LCons x l) = wenzelm@20820: CONS (Datatype.Leaf x) (Rep_llist l)" wenzelm@18400: by (simp add: LCons_def Abs_llist_inverse CONS_type Rep_llist) wenzelm@18400: wenzelm@20802: lemma llist_cases [cases type: llist]: wenzelm@20802: obtains wenzelm@20802: (LNil) "l = LNil" wenzelm@20802: | (LCons) x l' where "l = LCons x l'" wenzelm@18400: proof (cases l) wenzelm@18400: case (Abs_llist L) wenzelm@20820: from `L \ llist` have "L \ LList (range Datatype.Leaf)" by (rule llistD) wenzelm@18400: then show ?thesis wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: with Abs_llist have "l = LNil" by (simp add: LNil_def) wenzelm@18400: with LNil show ?thesis . wenzelm@18400: next wenzelm@18400: case (CONS K a) wenzelm@18400: then have "K \ llist" by (blast intro: llistI) wenzelm@18400: then obtain l' where "K = Rep_llist l'" by cases wenzelm@18400: with CONS and Abs_llist obtain x where "l = LCons x l'" wenzelm@18400: by (auto simp add: LCons_def Abs_llist_inject) wenzelm@18400: with LCons show ?thesis . wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "llist_case c d l = wenzelm@20820: List_case c (\x y. d (inv Datatype.Leaf x) (Abs_llist y)) (Rep_llist l)" wenzelm@20770: wenzelm@20770: syntax (* FIXME? *) wenzelm@20770: LNil :: logic wenzelm@20770: LCons :: logic wenzelm@18400: translations wenzelm@20770: "case p of LNil \ a | LCons x l \ b" \ "CONST llist_case a (\x l. b) p" wenzelm@18400: wenzelm@18400: lemma llist_case_LNil [simp]: "llist_case c d LNil = c" wenzelm@18400: by (simp add: llist_case_def LNil_def wenzelm@18400: NIL_type Abs_llist_inverse) wenzelm@18400: wenzelm@18400: lemma llist_case_LCons [simp]: "llist_case c d (LCons M N) = d M N" wenzelm@18400: by (simp add: llist_case_def LCons_def wenzelm@18400: CONS_type Abs_llist_inverse Rep_llist Rep_llist_inverse inj_Leaf) wenzelm@18400: wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "llist_corec a f = wenzelm@18400: Abs_llist (LList_corec a wenzelm@18400: (\z. wenzelm@18400: case f z of None \ None wenzelm@20820: | Some (v, w) \ Some (Datatype.Leaf v, w)))" wenzelm@18400: wenzelm@18400: lemma LList_corec_type2: wenzelm@18400: "LList_corec a wenzelm@18400: (\z. case f z of None \ None wenzelm@20820: | Some (v, w) \ Some (Datatype.Leaf v, w)) \ llist" wenzelm@18400: (is "?corec a \ _") wenzelm@18400: proof (unfold llist_def) wenzelm@18400: let "LList_corec a ?g" = "?corec a" wenzelm@18400: have "?corec a \ {?corec x | x. True}" by blast wenzelm@20820: then show "?corec a \ LList (range Datatype.Leaf)" wenzelm@18400: proof coinduct wenzelm@18400: case (LList L) wenzelm@18400: then obtain x where L: "L = ?corec x" by blast wenzelm@18400: show ?case wenzelm@18400: proof (cases "f x") wenzelm@18400: case None wenzelm@18400: then have "?corec x = NIL" wenzelm@18400: by (simp add: LList_corec) wenzelm@18400: with L have ?NIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case (Some p) wenzelm@18400: then have "?corec x = wenzelm@20820: CONS (Datatype.Leaf (fst p)) (?corec (snd p))" wenzelm@18400: by (simp add: split_def LList_corec) wenzelm@18400: with L have ?CONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma llist_corec: wenzelm@18400: "llist_corec a f = wenzelm@18400: (case f a of None \ LNil | Some (z, w) \ LCons z (llist_corec w f))" wenzelm@18400: proof (cases "f a") wenzelm@18400: case None wenzelm@18400: then show ?thesis wenzelm@18400: by (simp add: llist_corec_def LList_corec LNil_def) wenzelm@18400: next wenzelm@18400: case (Some p) wenzelm@18400: wenzelm@18400: let "?corec a" = "llist_corec a f" wenzelm@18400: let "?rep_corec a" = wenzelm@18400: "LList_corec a wenzelm@18400: (\z. case f z of None \ None wenzelm@20820: | Some (v, w) \ Some (Datatype.Leaf v, w))" wenzelm@18400: wenzelm@18400: have "?corec a = Abs_llist (?rep_corec a)" wenzelm@18400: by (simp only: llist_corec_def) wenzelm@18400: also from Some have "?rep_corec a = wenzelm@20820: CONS (Datatype.Leaf (fst p)) (?rep_corec (snd p))" wenzelm@18400: by (simp add: split_def LList_corec) wenzelm@18400: also have "?rep_corec (snd p) = Rep_llist (?corec (snd p))" wenzelm@18400: by (simp only: llist_corec_def Abs_llist_inverse LList_corec_type2) wenzelm@18400: finally have "?corec a = LCons (fst p) (?corec (snd p))" wenzelm@18400: by (simp only: LCons_def) wenzelm@18400: with Some show ?thesis by (simp add: split_def) wenzelm@18400: qed wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection {* Equality as greatest fixed-point; the bisimulation principle. *} wenzelm@18400: wenzelm@18400: consts wenzelm@20820: EqLList :: "('a Datatype.item \ 'a Datatype.item) set \ wenzelm@20820: ('a Datatype.item \ 'a Datatype.item) set" wenzelm@18400: wenzelm@18400: coinductive "EqLList r" wenzelm@18400: intros wenzelm@18400: EqNIL: "(NIL, NIL) \ EqLList r" wenzelm@18400: EqCONS: "(a, b) \ r \ (M, N) \ EqLList r \ wenzelm@18400: (CONS a M, CONS b N) \ EqLList r" wenzelm@18400: wenzelm@18400: lemma EqLList_unfold: wenzelm@20820: "EqLList r = dsum (diag {Datatype.Numb 0}) (dprod r (EqLList r))" wenzelm@18400: by (fast intro!: EqLList.intros [unfolded NIL_def CONS_def] wenzelm@18400: elim: EqLList.cases [unfolded NIL_def CONS_def]) wenzelm@18400: wenzelm@18400: lemma EqLList_implies_ntrunc_equality: wenzelm@18400: "(M, N) \ EqLList (diag A) \ ntrunc k M = ntrunc k N" wenzelm@20503: apply (induct k arbitrary: M N rule: nat_less_induct) wenzelm@18400: apply (erule EqLList.cases) wenzelm@18400: apply (safe del: equalityI) wenzelm@18400: apply (case_tac n) wenzelm@18400: apply simp wenzelm@18400: apply (rename_tac n') wenzelm@18400: apply (case_tac n') wenzelm@18400: apply (simp_all add: CONS_def less_Suc_eq) wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma Domain_EqLList: "Domain (EqLList (diag A)) \ LList A" wenzelm@18400: apply (simp add: LList.defs NIL_def CONS_def) wenzelm@18400: apply (rule gfp_upperbound) wenzelm@18400: apply (subst EqLList_unfold) wenzelm@18400: apply auto wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma EqLList_diag: "EqLList (diag A) = diag (LList A)" wenzelm@18400: (is "?lhs = ?rhs") wenzelm@18400: proof wenzelm@18400: show "?lhs \ ?rhs" wenzelm@18400: apply (rule subsetI) wenzelm@18400: apply (rule_tac p = x in PairE) wenzelm@18400: apply clarify wenzelm@18400: apply (rule diag_eqI) wenzelm@18400: apply (rule EqLList_implies_ntrunc_equality [THEN ntrunc_equality], wenzelm@18400: assumption) wenzelm@18400: apply (erule DomainI [THEN Domain_EqLList [THEN subsetD]]) wenzelm@18400: done wenzelm@18400: show "?rhs \ ?lhs" wenzelm@18400: proof wenzelm@18400: fix p assume "p \ diag (LList A)" wenzelm@18400: then show "p \ EqLList (diag A)" wenzelm@18400: proof coinduct wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain L where L: "L \ LList A" and q: "q = (L, L)" .. wenzelm@18400: from L show ?case wenzelm@18400: proof cases wenzelm@18400: case NIL with q have ?EqNIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case CONS with q have ?EqCONS by (simp add: diagI) wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma EqLList_diag_iff [iff]: "(p \ EqLList (diag A)) = (p \ diag (LList A))" wenzelm@18400: by (simp only: EqLList_diag) wenzelm@18400: wenzelm@18400: wenzelm@18400: text {* wenzelm@18400: To show two LLists are equal, exhibit a bisimulation! (Also admits wenzelm@18400: true equality.) wenzelm@18400: *} wenzelm@18400: wenzelm@18400: lemma LList_equalityI wenzelm@18400: [consumes 1, case_names EqLList, case_conclusion EqLList EqNIL EqCONS]: wenzelm@18400: assumes r: "(M, N) \ r" wenzelm@18400: and step: "\p. p \ r \ wenzelm@18400: p = (NIL, NIL) \ wenzelm@18400: (\M N a b. wenzelm@18400: p = (CONS a M, CONS b N) \ (a, b) \ diag A \ wenzelm@18400: (M, N) \ r \ EqLList (diag A))" wenzelm@18400: shows "M = N" wenzelm@18400: proof - wenzelm@18400: from r have "(M, N) \ EqLList (diag A)" wenzelm@18400: proof coinduct wenzelm@18400: case EqLList wenzelm@18400: then show ?case by (rule step) wenzelm@18400: qed wenzelm@18400: then show ?thesis by auto wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma LList_fun_equalityI wenzelm@18400: [consumes 1, case_names NIL_type NIL CONS, case_conclusion CONS EqNIL EqCONS]: wenzelm@18400: assumes M: "M \ LList A" wenzelm@18400: and fun_NIL: "g NIL \ LList A" "f NIL = g NIL" wenzelm@18400: and fun_CONS: "\x l. x \ A \ l \ LList A \ wenzelm@18400: (f (CONS x l), g (CONS x l)) = (NIL, NIL) \ wenzelm@18400: (\M N a b. wenzelm@18400: (f (CONS x l), g (CONS x l)) = (CONS a M, CONS b N) \ wenzelm@18400: (a, b) \ diag A \ wenzelm@18400: (M, N) \ {(f u, g u) | u. u \ LList A} \ diag (LList A))" wenzelm@18400: (is "\x l. _ \ _ \ ?fun_CONS x l") wenzelm@18400: shows "f M = g M" wenzelm@18400: proof - wenzelm@18400: let ?bisim = "{(f L, g L) | L. L \ LList A}" wenzelm@18400: have "(f M, g M) \ ?bisim" using M by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof (coinduct taking: A rule: LList_equalityI) wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain L where q: "q = (f L, g L)" and L: "L \ LList A" by blast wenzelm@18400: from L show ?case wenzelm@18400: proof (cases L) wenzelm@18400: case NIL wenzelm@18400: with fun_NIL and q have "q \ diag (LList A)" by auto wenzelm@18400: then have "q \ EqLList (diag A)" .. wenzelm@18400: then show ?thesis by cases simp_all wenzelm@18400: next wenzelm@18400: case (CONS K a) wenzelm@18400: from fun_CONS and `a \ A` `K \ LList A` wenzelm@18400: have "?fun_CONS a K" (is "?NIL \ ?CONS") . wenzelm@18400: then show ?thesis wenzelm@18400: proof wenzelm@18400: assume ?NIL wenzelm@18400: with q CONS have "q \ diag (LList A)" by auto wenzelm@18400: then have "q \ EqLList (diag A)" .. wenzelm@18400: then show ?thesis by cases simp_all wenzelm@18400: next wenzelm@18400: assume ?CONS wenzelm@18400: with CONS obtain a b M N where wenzelm@18400: fg: "(f L, g L) = (CONS a M, CONS b N)" wenzelm@18400: and ab: "(a, b) \ diag A" wenzelm@18400: and MN: "(M, N) \ ?bisim \ diag (LList A)" wenzelm@18400: by blast wenzelm@18400: from MN show ?thesis wenzelm@18400: proof wenzelm@18400: assume "(M, N) \ ?bisim" wenzelm@18400: with q fg ab show ?thesis by simp wenzelm@18400: next wenzelm@18400: assume "(M, N) \ diag (LList A)" wenzelm@18400: then have "(M, N) \ EqLList (diag A)" .. wenzelm@18400: with q fg ab show ?thesis by simp wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: text {* wenzelm@18400: Finality of @{text "llist A"}: Uniqueness of functions defined by corecursion. wenzelm@18400: *} wenzelm@18400: wenzelm@18400: lemma equals_LList_corec: wenzelm@18400: assumes h: "\x. h x = wenzelm@18400: (case f x of None \ NIL | Some (z, w) \ CONS z (h w))" wenzelm@18400: shows "h x = (\x. LList_corec x f) x" wenzelm@18400: proof - wenzelm@18400: def h' \ "\x. LList_corec x f" wenzelm@18400: then have h': "\x. h' x = wenzelm@18400: (case f x of None \ NIL | Some (z, w) \ CONS z (h' w))" wenzelm@18730: unfolding h'_def by (simp add: LList_corec) wenzelm@18400: have "(h x, h' x) \ {(h u, h' u) | u. True}" by blast wenzelm@18400: then show "h x = h' x" wenzelm@18400: proof (coinduct rule: LList_equalityI [where A = UNIV]) wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain x where q: "q = (h x, h' x)" by blast wenzelm@18400: show ?case wenzelm@18400: proof (cases "f x") wenzelm@18400: case None wenzelm@18400: with h h' q have ?EqNIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case (Some p) wenzelm@18400: with h h' q have "q = wenzelm@18400: (CONS (fst p) (h (snd p)), CONS (fst p) (h' (snd p)))" wenzelm@18400: by (simp add: split_def) wenzelm@18400: then have ?EqCONS by (auto iff: diag_iff) wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: wenzelm@18400: lemma llist_equalityI wenzelm@18400: [consumes 1, case_names Eqllist, case_conclusion Eqllist EqLNil EqLCons]: wenzelm@18400: assumes r: "(l1, l2) \ r" wenzelm@18400: and step: "\q. q \ r \ wenzelm@18400: q = (LNil, LNil) \ wenzelm@18400: (\l1 l2 a b. wenzelm@18400: q = (LCons a l1, LCons b l2) \ a = b \ wenzelm@18400: ((l1, l2) \ r \ l1 = l2))" wenzelm@18400: (is "\q. _ \ ?EqLNil q \ ?EqLCons q") wenzelm@18400: shows "l1 = l2" wenzelm@18400: proof - wenzelm@18400: def M \ "Rep_llist l1" and N \ "Rep_llist l2" wenzelm@18400: with r have "(M, N) \ {(Rep_llist l1, Rep_llist l2) | l1 l2. (l1, l2) \ r}" wenzelm@18400: by blast wenzelm@18400: then have "M = N" wenzelm@18400: proof (coinduct rule: LList_equalityI [where A = UNIV]) wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain l1 l2 where wenzelm@18400: q: "q = (Rep_llist l1, Rep_llist l2)" and r: "(l1, l2) \ r" wenzelm@18400: by auto wenzelm@18400: from step [OF r] show ?case wenzelm@18400: proof wenzelm@18400: assume "?EqLNil (l1, l2)" wenzelm@18400: with q have ?EqNIL by (simp add: Rep_llist_LNil) wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: assume "?EqLCons (l1, l2)" wenzelm@18400: with q have ?EqCONS wenzelm@18400: by (force simp add: Rep_llist_LCons EqLList_diag intro: Rep_llist_UNIV) wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: then show ?thesis by (simp add: M_def N_def Rep_llist_inject) wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma llist_fun_equalityI wenzelm@18400: [case_names LNil LCons, case_conclusion LCons EqLNil EqLCons]: wenzelm@18400: assumes fun_LNil: "f LNil = g LNil" wenzelm@18400: and fun_LCons: "\x l. wenzelm@18400: (f (LCons x l), g (LCons x l)) = (LNil, LNil) \ wenzelm@18400: (\l1 l2 a b. wenzelm@18400: (f (LCons x l), g (LCons x l)) = (LCons a l1, LCons b l2) \ wenzelm@18400: a = b \ ((l1, l2) \ {(f u, g u) | u. True} \ l1 = l2))" wenzelm@18400: (is "\x l. ?fun_LCons x l") wenzelm@18400: shows "f l = g l" wenzelm@18400: proof - wenzelm@18400: have "(f l, g l) \ {(f l, g l) | l. True}" by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof (coinduct rule: llist_equalityI) wenzelm@18400: case (Eqllist q) wenzelm@18400: then obtain l where q: "q = (f l, g l)" by blast wenzelm@18400: show ?case wenzelm@18400: proof (cases l) wenzelm@18400: case LNil wenzelm@18400: with fun_LNil and q have "q = (g LNil, g LNil)" by simp wenzelm@18400: then show ?thesis by (cases "g LNil") simp_all wenzelm@18400: next wenzelm@18400: case (LCons x l') wenzelm@18400: with `?fun_LCons x l'` q LCons show ?thesis by blast wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection {* Derived operations -- both on the set and abstract type *} wenzelm@18400: wenzelm@18400: subsubsection {* @{text Lconst} *} wenzelm@18400: wenzelm@19086: definition wenzelm@18400: "Lconst M \ lfp (\N. CONS M N)" wenzelm@18400: wenzelm@18400: lemma Lconst_fun_mono: "mono (CONS M)" wenzelm@18400: by (simp add: monoI CONS_mono) wenzelm@18400: wenzelm@18400: lemma Lconst: "Lconst M = CONS M (Lconst M)" wenzelm@18400: by (rule Lconst_def [THEN def_lfp_unfold]) (rule Lconst_fun_mono) wenzelm@18400: wenzelm@18400: lemma Lconst_type: wenzelm@18400: assumes "M \ A" wenzelm@18400: shows "Lconst M \ LList A" wenzelm@18400: proof - wenzelm@18400: have "Lconst M \ {Lconst M}" by simp wenzelm@18400: then show ?thesis wenzelm@18400: proof coinduct wenzelm@18400: case (LList N) wenzelm@18400: then have "N = Lconst M" by simp wenzelm@18400: also have "\ = CONS M (Lconst M)" by (rule Lconst) wenzelm@18400: finally have ?CONS using `M \ A` by simp wenzelm@18400: then show ?case .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma Lconst_eq_LList_corec: "Lconst M = LList_corec M (\x. Some (x, x))" wenzelm@18400: apply (rule equals_LList_corec) wenzelm@18400: apply simp wenzelm@18400: apply (rule Lconst) wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma gfp_Lconst_eq_LList_corec: wenzelm@18400: "gfp (\N. CONS M N) = LList_corec M (\x. Some(x, x))" wenzelm@18400: apply (rule equals_LList_corec) wenzelm@18400: apply simp wenzelm@18400: apply (rule Lconst_fun_mono [THEN gfp_unfold]) wenzelm@18400: done wenzelm@18400: wenzelm@18400: wenzelm@18400: subsubsection {* @{text Lmap} and @{text lmap} *} wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "Lmap f M = LList_corec M (List_case None (\x M'. Some (f x, M')))" wenzelm@21404: definition wenzelm@19086: "lmap f l = llist_corec l wenzelm@18400: (\z. wenzelm@18400: case z of LNil \ None wenzelm@18400: | LCons y z \ Some (f y, z))" wenzelm@18400: wenzelm@18400: lemma Lmap_NIL [simp]: "Lmap f NIL = NIL" wenzelm@18400: and Lmap_CONS [simp]: "Lmap f (CONS M N) = CONS (f M) (Lmap f N)" wenzelm@18400: by (simp_all add: Lmap_def LList_corec) wenzelm@18400: wenzelm@18400: lemma Lmap_type: wenzelm@18400: assumes M: "M \ LList A" wenzelm@18400: and f: "\x. x \ A \ f x \ B" wenzelm@18400: shows "Lmap f M \ LList B" wenzelm@18400: proof - wenzelm@18400: from M have "Lmap f M \ {Lmap f N | N. N \ LList A}" by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof coinduct wenzelm@18400: case (LList L) wenzelm@18400: then obtain N where L: "L = Lmap f N" and N: "N \ LList A" by blast wenzelm@18400: from N show ?case wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: with L have ?NIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case (CONS K a) wenzelm@18400: with f L have ?CONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma Lmap_compose: wenzelm@18400: assumes M: "M \ LList A" wenzelm@18400: shows "Lmap (f o g) M = Lmap f (Lmap g M)" (is "?lhs M = ?rhs M") wenzelm@18400: proof - wenzelm@18400: have "(?lhs M, ?rhs M) \ {(?lhs N, ?rhs N) | N. N \ LList A}" wenzelm@18400: using M by blast wenzelm@18400: then show ?thesis wenzelm@20820: proof (coinduct taking: "range (\N :: 'a Datatype.item. N)" wenzelm@18400: rule: LList_equalityI) wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain N where q: "q = (?lhs N, ?rhs N)" and N: "N \ LList A" by blast wenzelm@18400: from N show ?case wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: with q have ?EqNIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case CONS wenzelm@18400: with q have ?EqCONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma Lmap_ident: wenzelm@18400: assumes M: "M \ LList A" wenzelm@18400: shows "Lmap (\x. x) M = M" (is "?lmap M = _") wenzelm@18400: proof - wenzelm@18400: have "(?lmap M, M) \ {(?lmap N, N) | N. N \ LList A}" using M by blast wenzelm@18400: then show ?thesis wenzelm@20820: proof (coinduct taking: "range (\N :: 'a Datatype.item. N)" wenzelm@18400: rule: LList_equalityI) wenzelm@18400: case (EqLList q) wenzelm@18400: then obtain N where q: "q = (?lmap N, N)" and N: "N \ LList A" by blast wenzelm@18400: from N show ?case wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: with q have ?EqNIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case CONS wenzelm@18400: with q have ?EqCONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma lmap_LNil [simp]: "lmap f LNil = LNil" wenzelm@18400: and lmap_LCons [simp]: "lmap f (LCons M N) = LCons (f M) (lmap f N)" wenzelm@18400: by (simp_all add: lmap_def llist_corec) wenzelm@18400: wenzelm@18400: lemma lmap_compose [simp]: "lmap (f o g) l = lmap f (lmap g l)" wenzelm@18400: by (coinduct _ _ l rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma lmap_ident [simp]: "lmap (\x. x) l = l" wenzelm@18400: by (coinduct _ _ l rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: wenzelm@18400: wenzelm@18400: subsubsection {* @{text Lappend} *} wenzelm@18400: wenzelm@19086: definition wenzelm@19086: "Lappend M N = LList_corec (M, N) wenzelm@18400: (split (List_case wenzelm@18400: (List_case None (\N1 N2. Some (N1, (NIL, N2)))) wenzelm@18400: (\M1 M2 N. Some (M1, (M2, N)))))" wenzelm@21404: definition wenzelm@19086: "lappend l n = llist_corec (l, n) wenzelm@18400: (split (llist_case wenzelm@18400: (llist_case None (\n1 n2. Some (n1, (LNil, n2)))) wenzelm@18400: (\l1 l2 n. Some (l1, (l2, n)))))" wenzelm@18400: wenzelm@18400: lemma Lappend_NIL_NIL [simp]: wenzelm@18400: "Lappend NIL NIL = NIL" wenzelm@18400: and Lappend_NIL_CONS [simp]: wenzelm@18400: "Lappend NIL (CONS N N') = CONS N (Lappend NIL N')" wenzelm@18400: and Lappend_CONS [simp]: wenzelm@18400: "Lappend (CONS M M') N = CONS M (Lappend M' N)" wenzelm@18400: by (simp_all add: Lappend_def LList_corec) wenzelm@18400: wenzelm@18400: lemma Lappend_NIL [simp]: "M \ LList A \ Lappend NIL M = M" wenzelm@18400: by (erule LList_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma Lappend_NIL2: "M \ LList A \ Lappend M NIL = M" wenzelm@18400: by (erule LList_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma Lappend_type: wenzelm@18400: assumes M: "M \ LList A" and N: "N \ LList A" wenzelm@18400: shows "Lappend M N \ LList A" wenzelm@18400: proof - wenzelm@18400: have "Lappend M N \ {Lappend u v | u v. u \ LList A \ v \ LList A}" wenzelm@18400: using M N by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof coinduct wenzelm@18400: case (LList L) wenzelm@18400: then obtain M N where L: "L = Lappend M N" wenzelm@18400: and M: "M \ LList A" and N: "N \ LList A" wenzelm@18400: by blast wenzelm@18400: from M show ?case wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: from N show ?thesis wenzelm@18400: proof cases wenzelm@18400: case NIL wenzelm@18400: with L and `M = NIL` have ?NIL by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: next wenzelm@18400: case CONS wenzelm@18400: with L and `M = NIL` have ?CONS by simp wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: next wenzelm@18400: case CONS wenzelm@18400: with L N have ?CONS by auto wenzelm@18400: then show ?thesis .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma lappend_LNil_LNil [simp]: "lappend LNil LNil = LNil" wenzelm@18400: and lappend_LNil_LCons [simp]: "lappend LNil (LCons l l') = LCons l (lappend LNil l')" wenzelm@18400: and lappend_LCons [simp]: "lappend (LCons l l') m = LCons l (lappend l' m)" wenzelm@18400: by (simp_all add: lappend_def llist_corec) wenzelm@18400: wenzelm@18400: lemma lappend_LNil1 [simp]: "lappend LNil l = l" wenzelm@18400: by (coinduct _ _ l rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma lappend_LNil2 [simp]: "lappend l LNil = l" wenzelm@18400: by (coinduct _ _ l rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma lappend_assoc: "lappend (lappend l1 l2) l3 = lappend l1 (lappend l2 l3)" wenzelm@18400: by (coinduct _ _ l1 rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: lemma lmap_lappend_distrib: "lmap f (lappend l n) = lappend (lmap f l) (lmap f n)" wenzelm@18400: by (coinduct _ _ l rule: llist_fun_equalityI) auto wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection{* iterates *} wenzelm@18400: wenzelm@18400: text {* @{text llist_fun_equalityI} cannot be used here! *} wenzelm@18400: wenzelm@19086: definition wenzelm@21404: iterates :: "('a \ 'a) \ 'a \ 'a llist" where wenzelm@19086: "iterates f a = llist_corec a (\x. Some (x, f x))" wenzelm@18400: wenzelm@18400: lemma iterates: "iterates f x = LCons x (iterates f (f x))" wenzelm@18400: apply (unfold iterates_def) wenzelm@18400: apply (subst llist_corec) wenzelm@18400: apply simp wenzelm@18400: done wenzelm@18400: wenzelm@18400: lemma lmap_iterates: "lmap f (iterates f x) = iterates f (f x)" wenzelm@18400: proof - wenzelm@18400: have "(lmap f (iterates f x), iterates f (f x)) \ wenzelm@18400: {(lmap f (iterates f u), iterates f (f u)) | u. True}" by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof (coinduct rule: llist_equalityI) wenzelm@18400: case (Eqllist q) wenzelm@18400: then obtain x where q: "q = (lmap f (iterates f x), iterates f (f x))" wenzelm@18400: by blast wenzelm@18400: also have "iterates f (f x) = LCons (f x) (iterates f (f (f x)))" wenzelm@18400: by (subst iterates) rule wenzelm@18400: also have "iterates f x = LCons x (iterates f (f x))" wenzelm@18400: by (subst iterates) rule wenzelm@18400: finally have ?EqLCons by auto wenzelm@18400: then show ?case .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma iterates_lmap: "iterates f x = LCons x (lmap f (iterates f x))" wenzelm@18400: by (subst lmap_iterates) (rule iterates) wenzelm@18400: wenzelm@18400: wenzelm@18400: subsection{* A rather complex proof about iterates -- cf.\ Andy Pitts *} wenzelm@18400: wenzelm@18400: lemma funpow_lmap: wenzelm@18400: fixes f :: "'a \ 'a" wenzelm@18400: shows "(lmap f ^ n) (LCons b l) = LCons ((f ^ n) b) ((lmap f ^ n) l)" wenzelm@18400: by (induct n) simp_all wenzelm@18400: wenzelm@18400: wenzelm@18400: lemma iterates_equality: wenzelm@18400: assumes h: "\x. h x = LCons x (lmap f (h x))" wenzelm@18400: shows "h = iterates f" wenzelm@18400: proof wenzelm@18400: fix x wenzelm@18400: have "(h x, iterates f x) \ wenzelm@18400: {((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u)) | u n. True}" wenzelm@18400: proof - wenzelm@18400: have "(h x, iterates f x) = ((lmap f ^ 0) (h x), (lmap f ^ 0) (iterates f x))" wenzelm@18400: by simp wenzelm@18400: then show ?thesis by blast wenzelm@18400: qed wenzelm@18400: then show "h x = iterates f x" wenzelm@18400: proof (coinduct rule: llist_equalityI) wenzelm@18400: case (Eqllist q) wenzelm@18400: then obtain u n where "q = ((lmap f ^ n) (h u), (lmap f ^ n) (iterates f u))" wenzelm@18400: (is "_ = (?q1, ?q2)") wenzelm@18400: by auto wenzelm@18400: also have "?q1 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (h u))" wenzelm@18400: proof - wenzelm@18400: have "?q1 = (lmap f ^ n) (LCons u (lmap f (h u)))" wenzelm@18400: by (subst h) rule wenzelm@18400: also have "\ = LCons ((f ^ n) u) ((lmap f ^ n) (lmap f (h u)))" wenzelm@18400: by (rule funpow_lmap) wenzelm@18400: also have "(lmap f ^ n) (lmap f (h u)) = (lmap f ^ Suc n) (h u)" wenzelm@18400: by (simp add: funpow_swap1) wenzelm@18400: finally show ?thesis . wenzelm@18400: qed wenzelm@18400: also have "?q2 = LCons ((f ^ n) u) ((lmap f ^ Suc n) (iterates f u))" wenzelm@18400: proof - wenzelm@18400: have "?q2 = (lmap f ^ n) (LCons u (iterates f (f u)))" wenzelm@18400: by (subst iterates) rule wenzelm@18400: also have "\ = LCons ((f ^ n) u) ((lmap f ^ n) (iterates f (f u)))" wenzelm@18400: by (rule funpow_lmap) wenzelm@18400: also have "(lmap f ^ n) (iterates f (f u)) = (lmap f ^ Suc n) (iterates f u)" wenzelm@18400: by (simp add: lmap_iterates funpow_swap1) wenzelm@18400: finally show ?thesis . wenzelm@18400: qed wenzelm@18400: finally have ?EqLCons by (auto simp del: funpow.simps) wenzelm@18400: then show ?case .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: lemma lappend_iterates: "lappend (iterates f x) l = iterates f x" wenzelm@18400: proof - wenzelm@18400: have "(lappend (iterates f x) l, iterates f x) \ wenzelm@18400: {(lappend (iterates f u) l, iterates f u) | u. True}" by blast wenzelm@18400: then show ?thesis wenzelm@18400: proof (coinduct rule: llist_equalityI) wenzelm@18400: case (Eqllist q) wenzelm@18400: then obtain x where "q = (lappend (iterates f x) l, iterates f x)" by blast wenzelm@18400: also have "iterates f x = LCons x (iterates f (f x))" by (rule iterates) wenzelm@18400: finally have ?EqLCons by auto wenzelm@18400: then show ?case .. wenzelm@18400: qed wenzelm@18400: qed wenzelm@18400: wenzelm@18400: end