(*Coinductive definition of equality*) consts
lleq :: "i\i"
(*Previously used <*> in the domain and variant pairs as elements. But standard pairs work just as well. To use variant pairs, must change prefix
a q/Q to the Sigma, Pair and converse rules.*) coinductive
domains "lleq(A)"\<subseteq> "llist(A) * llist(A)" intros
LNil: "\LNil, LNil\ \ lleq(A)"
LCons: "\a \ A; \ lleq(A)\ \<Longrightarrow> <LCons(a,l), LCons(a,l')> \<in> lleq(A)"
type_intros llist.intros
(*Lazy list functions; flip is not definitional!*) definition
lconst :: "i \ i" where "lconst(a) \ lfp(univ(a), \l. LCons(a,l))"
axiomatization flip :: "i \ i" where
flip_LNil: "flip(LNil) = LNil"and
flip_LCons: "\x \ bool; l \ llist(bool)\ \<Longrightarrow> flip(LCons(x,l)) = LCons(not(x), flip(l))"
(*These commands cause classical reasoning to regard the subset relation
as primitive, not reducing it to membership*)
(*An elimination rule, for type-checking*) inductive_cases LConsE: "LCons(a,l) \ llist(A)"
(*Proving freeness results*) lemma LCons_iff: "LCons(a,l)=LCons(a',l') \ a=a' \ l=l'" by auto
lemma LNil_LCons_iff: "\ LNil=LCons(a,l)" by auto
(* lemma llist_unfold: "llist(A) = {0} <+> (A <*> llist(A))"; let open llist val rew = rewrite_rule con_defs in by (fast_tac (claset() addSIs (subsetI ::map rew intros) addEs [rew elim]) 1) end done
*)
(*** Lemmas to justify using "llist" in other recursive type definitions ***)
lemma llist_quniv_lemma: "Ord(i) \ l \ llist(quniv(A)) \ l \ Vset(i) \ univ(eclose(A))" proof (induct i arbitrary: l rule: trans_induct) case (step i l) show ?caseusing\<open>l \<in> llist(quniv(A))\<close> proof (cases l rule: llist.cases) case LNil thus ?thesis by (simp add: QInl_def QInr_def llist.con_defs) next case (LCons a l) thus ?thesis using step.hyps proof (simp add: QInl_def QInr_def llist.con_defs) show"<1; > \ Vset(i) \ univ(eclose(A))" using LCons \Ord(i)\ by (fast intro: step Ord_trans Int_lower1 [THEN subset_trans]) qed qed qed
(*Lemma for proving finality. Unfold the lazy list; use induction hypothesis*) lemma lleq_Int_Vset_subset: "Ord(i) \ \ lleq(A) \ l \ Vset(i) \ l'" proof (induct i arbitrary: l l' rule: trans_induct) case (step i l l') show ?caseusing\<open>\<langle>l, l'\<rangle> \<in> lleq(A)\<close> proof (cases rule: lleq.cases) case LNil thus ?thesis by (auto simp add: QInr_def llist.con_defs) next case (LCons a l l') thus ?thesis using step.hyps by (auto simp add: QInr_def llist.con_defs intro: Ord_trans) qed qed
(*lleq(A) is a symmetric relation because qconverse(lleq(A)) is a fixedpoint*) lemma lleq_symmetric: " \ lleq(A) \ \ lleq(A)" apply (erule lleq.coinduct [OF converseI]) apply (rule lleq.dom_subset [THEN converse_type], safe) apply (erule lleq.cases, blast+) done
(*Reasoning borrowed from lleq.ML; a similar proof works for all
"productive" functions -- cf Coquand's "Infinite Objects in Type Theory".*) lemma flip_llist_quniv_lemma: "Ord(i) \ l \ llist(bool) \ flip(l) \ Vset(i) \ univ(eclose(bool))" proof (induct i arbitrary: l rule: trans_induct) case (step i l) show ?caseusing\<open>l \<in> llist(bool)\<close> proof (cases l rule: llist.cases) case LNil thus ?thesis by (simp, simp add: QInl_def QInr_def llist.con_defs) next case (LCons a l) thus ?thesis using step.hyps proof (simp, simp add: QInl_def QInr_def llist.con_defs) show"<1; > \ Vset(i) \ univ(eclose(bool))" using LCons step.hyps by (auto intro: Ord_trans) qed qed qed
lemma flip_in_quniv: "l \ llist(bool) \ flip(l) \ quniv(bool)" by (rule flip_llist_quniv_lemma [THEN Int_Vset_subset, THEN qunivI], assumption+)
lemma flip_type: "l \ llist(bool) \ flip(l): llist(bool)" apply (rule_tac X = "{flip (l) . l \ llist (bool) }" in llist.coinduct) apply blast apply (fast intro!: flip_in_quniv) apply (erule RepFunE) apply (erule_tac a=la in llist.cases, auto) done
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.