(* Title: HOL/HOLCF/IOA/meta_theory/Seq.thy
Author: Olaf Müller
*)
section \<open>Partial, Finite and Infinite Sequences (lazy lists), modeled as domain\<close>
theory Seq
imports "../../HOLCF"
begin
default_sort pcpo
domain (unsafe) 'a seq = nil ("nil") | cons (HD :: 'a) (lazy TL :: "'a seq") (infixr "##" 65)
(*
sfilter :: "('a -> tr) -> 'a seq -> 'a seq"
smap :: "('a -> 'b) -> 'a seq -> 'b seq"
sforall :: "('a -> tr) => 'a seq => bool"
sforall2 :: "('a -> tr) -> 'a seq -> tr"
slast :: "'a seq -> 'a"
sconc :: "'a seq -> 'a seq -> 'a seq"
sdropwhile :: "('a -> tr) -> 'a seq -> 'a seq"
stakewhile :: "('a -> tr) -> 'a seq -> 'a seq"
szip :: "'a seq -> 'b seq -> ('a*'b) seq"
sflat :: "('a seq) seq -> 'a seq"
sfinite :: "'a seq set"
Partial :: "'a seq => bool"
Infinite :: "'a seq => bool"
nproj :: "nat => 'a seq => 'a"
sproj :: "nat => 'a seq => 'a seq"
*)
inductive
Finite :: "'a seq => bool"
where
sfinite_0: "Finite nil"
| sfinite_n: "[| Finite tr; a~=UU |] ==> Finite (a##tr)"
declare Finite.intros [simp]
definition
Partial :: "'a seq => bool"
where
"Partial x == (seq_finite x) & ~(Finite x)"
definition
Infinite :: "'a seq => bool"
where
"Infinite x == ~(seq_finite x)"
subsection \<open>recursive equations of operators\<close>
subsubsection \<open>smap\<close>
fixrec
smap :: "('a -> 'b) -> 'a seq -> 'b seq"
where
smap_nil: "smap$f$nil=nil"
| smap_cons: "[|x~=UU|] ==> smap$f$(x##xs)= (f$x)##smap$f$xs"
lemma smap_UU [simp]: "smap$f$UU=UU"
by fixrec_simp
subsubsection \<open>sfilter\<close>
fixrec
sfilter :: "('a -> tr) -> 'a seq -> 'a seq"
where
sfilter_nil: "sfilter$P$nil=nil"
| sfilter_cons:
"x~=UU ==> sfilter$P$(x##xs)=
(If P$x then x##(sfilter$P$xs) else sfilter$P$xs)"
lemma sfilter_UU [simp]: "sfilter$P$UU=UU"
by fixrec_simp
subsubsection \<open>sforall2\<close>
fixrec
sforall2 :: "('a -> tr) -> 'a seq -> tr"
where
sforall2_nil: "sforall2$P$nil=TT"
| sforall2_cons:
"x~=UU ==> sforall2$P$(x##xs)= ((P$x) andalso sforall2$P$xs)"
lemma sforall2_UU [simp]: "sforall2$P$UU=UU"
by fixrec_simp
definition
sforall_def: "sforall P t == (sforall2$P$t ~=FF)"
subsubsection \<open>stakewhile\<close>
fixrec
stakewhile :: "('a -> tr) -> 'a seq -> 'a seq"
where
stakewhile_nil: "stakewhile$P$nil=nil"
| stakewhile_cons:
"x~=UU ==> stakewhile$P$(x##xs) =
(If P$x then x##(stakewhile$P$xs) else nil)"
lemma stakewhile_UU [simp]: "stakewhile$P$UU=UU"
by fixrec_simp
subsubsection \<open>sdropwhile\<close>
fixrec
sdropwhile :: "('a -> tr) -> 'a seq -> 'a seq"
where
sdropwhile_nil: "sdropwhile$P$nil=nil"
| sdropwhile_cons:
"x~=UU ==> sdropwhile$P$(x##xs) =
(If P$x then sdropwhile$P$xs else x##xs)"
lemma sdropwhile_UU [simp]: "sdropwhile$P$UU=UU"
by fixrec_simp
subsubsection \<open>slast\<close>
fixrec
slast :: "'a seq -> 'a"
where
slast_nil: "slast$nil=UU"
| slast_cons:
"x~=UU ==> slast$(x##xs)= (If is_nil$xs then x else slast$xs)"
lemma slast_UU [simp]: "slast$UU=UU"
by fixrec_simp
subsubsection \<open>sconc\<close>
fixrec
sconc :: "'a seq -> 'a seq -> 'a seq"
where
sconc_nil: "sconc$nil$y = y"
| sconc_cons':
"x~=UU ==> sconc$(x##xs)$y = x##(sconc$xs$y)"
abbreviation
sconc_syn :: "'a seq => 'a seq => 'a seq" (infixr "@@" 65) where
"xs @@ ys == sconc $ xs $ ys"
lemma sconc_UU [simp]: "UU @@ y=UU"
by fixrec_simp
lemma sconc_cons [simp]: "(x##xs) @@ y=x##(xs @@ y)"
apply (cases "x=UU")
apply simp_all
done
declare sconc_cons' [simp del]
subsubsection \<open>sflat\<close>
fixrec
sflat :: "('a seq) seq -> 'a seq"
where
sflat_nil: "sflat$nil=nil"
| sflat_cons': "x~=UU ==> sflat$(x##xs)= x@@(sflat$xs)"
lemma sflat_UU [simp]: "sflat$UU=UU"
by fixrec_simp
lemma sflat_cons [simp]: "sflat$(x##xs)= x@@(sflat$xs)"
by (cases "x=UU", simp_all)
declare sflat_cons' [simp del]
subsubsection \<open>szip\<close>
fixrec
szip :: "'a seq -> 'b seq -> ('a*'b) seq"
where
szip_nil: "szip$nil$y=nil"
| szip_cons_nil: "x~=UU ==> szip$(x##xs)$nil=UU"
| szip_cons:
"[| x~=UU; y~=UU|] ==> szip$(x##xs)$(y##ys) = (x,y)##szip$xs$ys"
lemma szip_UU1 [simp]: "szip$UU$y=UU"
by fixrec_simp
lemma szip_UU2 [simp]: "x~=nil ==> szip$x$UU=UU"
by (cases x, simp_all, fixrec_simp)
subsection "scons, nil"
lemma scons_inject_eq:
"[|x~=UU;y~=UU|]==> (x##xs=y##ys) = (x=y & xs=ys)"
by simp
lemma nil_less_is_nil: "nil<<x ==> nil=x"
apply (cases x)
apply simp
apply simp
apply simp
done
subsection "sfilter, sforall, sconc"
lemma if_and_sconc [simp]: "(if b then tr1 else tr2) @@ tr
= (if b then tr1 @@ tr else tr2 @@ tr)"
by simp
lemma sfiltersconc: "sfilter$P$(x @@ y) = (sfilter$P$x @@ sfilter$P$y)"
apply (induct x)
(* adm *)
apply simp
(* base cases *)
apply simp
apply simp
(* main case *)
apply (rule_tac p="P$a" in trE)
apply simp
apply simp
apply simp
done
lemma sforallPstakewhileP: "sforall P (stakewhile$P$x)"
apply (simp add: sforall_def)
apply (induct x)
(* adm *)
apply simp
(* base cases *)
apply simp
apply simp
(* main case *)
apply (rule_tac p="P$a" in trE)
apply simp
apply simp
apply simp
done
lemma forallPsfilterP: "sforall P (sfilter$P$x)"
apply (simp add: sforall_def)
apply (induct x)
(* adm *)
apply simp
(* base cases *)
apply simp
apply simp
(* main case *)
apply (rule_tac p="P$a" in trE)
apply simp
apply simp
apply simp
done
subsection "Finite"
(* ---------------------------------------------------- *)
(* Proofs of rewrite rules for Finite: *)
(* 1. Finite(nil), (by definition) *)
(* 2. ~Finite(UU), *)
(* 3. a~=UU==> Finite(a##x)=Finite(x) *)
(* ---------------------------------------------------- *)
lemma Finite_UU_a: "Finite x --> x~=UU"
apply (rule impI)
apply (erule Finite.induct)
apply simp
apply simp
done
lemma Finite_UU [simp]: "~(Finite UU)"
apply (cut_tac x="UU" in Finite_UU_a)
apply fast
done
lemma Finite_cons_a: "Finite x --> a~=UU --> x=a##xs --> Finite xs"
apply (intro strip)
apply (erule Finite.cases)
apply fastforce
apply simp
done
lemma Finite_cons: "a~=UU ==>(Finite (a##x)) = (Finite x)"
apply (rule iffI)
apply (erule (1) Finite_cons_a [rule_format])
apply fast
apply simp
done
lemma Finite_upward: "\<lbrakk>Finite x; x \<sqsubseteq> y\<rbrakk> \<Longrightarrow> Finite y"
apply (induct arbitrary: y set: Finite)
apply (case_tac y, simp, simp, simp)
apply (case_tac y, simp, simp)
apply simp
done
lemma adm_Finite [simp]: "adm Finite"
by (rule adm_upward, rule Finite_upward)
subsection "induction"
(*-------------------------------- *)
(* Extensions to Induction Theorems *)
(*-------------------------------- *)
lemma seq_finite_ind_lemma:
assumes "(!!n. P(seq_take n$s))"
shows "seq_finite(s) -->P(s)"
apply (unfold seq.finite_def)
apply (intro strip)
apply (erule exE)
apply (erule subst)
apply (rule assms)
done
lemma seq_finite_ind: "!!P.[|P(UU);P(nil);
!! x s1.[|x~=UU;P(s1)|] ==> P(x##s1)
|] ==> seq_finite(s) --> P(s)"
apply (rule seq_finite_ind_lemma)
apply (erule seq.finite_induct)
apply assumption
apply simp
done
end