(* Title: HOL/Induct/SList.thy Author: Lawrence C Paulson, Cambridge University Computer Laboratory
This theory is strictly of historical interest. It illustrates how recursive datatypes can be constructed in higher-order logic from first principles. Isabelle's datatype package automates a construction of this sort.
Enriched theory of lists; mutual indirect recursive data-types.
Definition of type 'a list (strict lists) by a least fixed point
We use list(A) == lfp(%Z. {NUMB(0)} <+> A \<times> Z) and not list == lfp(%Z. {NUMB(0)} <+> range(Leaf) \<times> Z)
so that list can serve as a "functor" for defining other recursive types.
This enables the conservative construction of mutual recursive datatypes such as
datatype 'a m = Node 'a * 'a m list
*)
section \<open>Extended List Theory (old)\<close>
theory SList imports Sexp begin
(*Hilbert_Choice is needed for the function "inv"*)
(* *********************************************************************** *) (* *) (* Building up data type *) (* *) (* *********************************************************************** *)
definition
CONS :: "['a item, 'a item] => 'a item"where "CONS M N = In1(Scons M N)"
inductive_set
list :: "'a item set => 'a item set" for A :: "'a item set" where
NIL_I: "NIL \ list A"
| CONS_I: "[| a \ A; M \ list A |] ==> CONS a M \ list A"
definition"List = list (range Leaf)"
typedef'a list = "List :: 'a item set" morphisms Rep_List Abs_List unfolding List_def by (blast intro: list.NIL_I)
definition
List_case :: "['b, ['a item, 'a item]=>'b, 'a item] => 'b"where "List_case c d = Case(%x. c)(Split(d))"
definition
List_rec :: "['a item, 'b, ['a item, 'a item, 'b]=>'b] => 'b"where "List_rec M c d = wfrec (pred_sexp\<^sup>+)
(%g. List_case c (%x y. d x y (g y))) M"
(* *********************************************************************** *) (* *) (* Abstracting data type *) (* *) (* *********************************************************************** *)
definition
Nil :: "'a list" (\<open>[]\<close>) where "Nil = Abs_List(NIL)"
definition "Cons" :: "['a, 'a list] => 'a list" (infixr\<open>#\<close> 65) where "x#xs = Abs_List(CONS (Leaf x)(Rep_List xs))"
definition (* list Recursion -- the trancl is Essential; see list.ML *)
list_rec :: "['a list, 'b, ['a, 'a list, 'b]=>'b] => 'b"where "list_rec l c d =
List_rec(Rep_List l) c (%x y r. d(inv Leaf x)(Abs_List y) r)"
definition
list_case :: "['b, ['a, 'a list]=>'b, 'a list] => 'b"where "list_case a f xs = list_rec xs a (%x xs r. f x xs)"
lemmas Cons_inject2 = Cons_Cons_eq [THEN iffD1, THEN conjE]
lemma CONS_D: "CONS M N \ list(A) \ M \ A & N \ list(A)" by (induct L == "CONS M N" rule: list.induct) auto
lemma sexp_CONS_D: "CONS M N \ sexp \ M \ sexp \ N \ sexp" apply (simp add: CONS_def In1_def) apply (fast dest!: Scons_D) done
(*Reasoning about constructors and their freeness*)
lemma not_CONS_self: "N \ list(A) \ \M. N \ CONS M N" apply (erule list.induct) apply simp_all done
lemma not_Cons_self2: "\x. l \ x#l" by (induct l rule: list_induct) simp_all
lemma neq_Nil_conv2: "(xs \ []) = (\y ys. xs = y#ys)" by (induct xs rule: list_induct) auto
(** Conversion rules for List_case: case analysis operator **)
lemma List_case_NIL [simp]: "List_case c h NIL = c" by (simp add: List_case_def NIL_def)
lemma List_case_CONS [simp]: "List_case c h (CONS M N) = h M N" by (simp add: List_case_def CONS_def)
(*** List_rec -- by wf recursion on pred_sexp ***)
(* The trancl(pred_sexp) is essential because pred_sexp_CONS_I1,2 would not
hold if pred_sexp^+ were changed to pred_sexp. *)
lemma List_rec_unfold_lemma: "(\M. List_rec M c d) \
wfrec (pred_sexp\<^sup>+) (\<lambda>g. List_case c (\<lambda>x y. d x y (g y)))" by (simp add: List_rec_def)
lemma List_rec_NIL [simp]: "List_rec NIL c h = c" apply (rule List_rec_unfold [THEN trans]) apply (simp add: List_case_NIL) done
lemma List_rec_CONS [simp]: "[| M \ sexp; N \ sexp |]
==> List_rec (CONS M N) c h = h M N (List_rec N c h)" apply (rule List_rec_unfold [THEN trans]) apply (simp add: pred_sexp_CONS_I2) done
lemma list_rec_Nil [simp]: "list_rec Nil c h = c" by (simp add: list_rec_def ListI [THEN Abs_List_inverse] Nil_def)
lemma list_rec_Cons [simp]: "list_rec (a#l) c h = h a l (list_rec l c h)" by (simp add: list_rec_def ListI [THEN Abs_List_inverse] Cons_def
Rep_List_inverse Rep_List [THEN ListD] inj_Leaf Rep_List_in_sexp)
(*Type checking. Useful?*) lemma List_rec_type: "[| M \ list(A);
A<=sexp;
c \<in> C(NIL); \<And>x y r. [| x \<in> A; y \<in> list(A); r \<in> C(y) |] ==> h x y r \<in> C(CONS x y)
|] ==> List_rec M c h \<in> C(M :: 'a item)" apply (erule list.induct, simp) apply (insert list_subset_sexp) apply (subst List_rec_CONS, blast+) done
(** Generalized map functionals **)
lemma Rep_map_Nil [simp]: "Rep_map f Nil = NIL" by (simp add: Rep_map_def)
lemma Rep_map_Cons [simp]: "Rep_map f(x#xs) = CONS(f x)(Rep_map f xs)" by (simp add: Rep_map_def)
lemma Abs_map_NIL [simp]: "Abs_map g NIL = Nil" by (simp add: Abs_map_def)
lemma Abs_map_CONS [simp]: "[| M \ sexp; N \ sexp |] ==> Abs_map g (CONS M N) = g(M) # Abs_map g N" by (simp add: Abs_map_def)
(*Eases the use of primitive recursion.*) lemma def_list_rec_NilCons: "[| \xs. f(xs) = list_rec xs c h |]
==> f [] = c \<and> f(x#xs) = h x xs (f xs)" by simp
lemma Abs_map_inverse: "[| M \ list(A); A<=sexp; \z. z \ A ==> f(g(z)) = z |]
==> Rep_map f (Abs_map g M) = M" apply (erule list.induct, simp_all) apply (insert list_subset_sexp) apply (subst Abs_map_CONS, blast) apply blast apply simp done
(*Rep_map_inverse is obtained via Abs_Rep_map and map_ident*)
(** list_case **)
(* setting up rewrite sets *)
text\<open>Better to have a single theorem with a conjunctive conclusion.\<close> declare def_list_rec_NilCons [OF list_case_def, simp]
(** list_case **)
lemma expand_list_case: "P(list_case a f xs) = ((xs=[] \ P a ) \ (\y ys. xs=y#ys \ P(f y ys)))" by (induct xs rule: list_induct) simp_all
(**** Function definitions ****)
declare def_list_rec_NilCons [OF map_def, simp]
(** The functional "map" and the generalized functionals **)
lemma take_Nil [simp]: "take [] n = []" by (induct n) simp_all
lemma take_take_eq [simp]: "\n. take (take xs n) n = take xs n" apply (induct xs rule: list_induct) apply simp_all apply (rule allI) apply (induct_tac n) apply auto done
end
¤ 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.0.2Bemerkung:
(vorverarbeitet)
¤
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.