src/HOL/HOLCF/IOA/meta_theory/Seq.thy

list comprehension: strip positions where the translation cannot handle them right now;

(*  Title:      HOLCF/IOA/meta_theory/Seq.thy
    Author:     Olaf Müller
*)

header {* Partial, Finite and Infinite Sequences (lazy lists), modeled as domain *}

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 {* recursive equations of operators *}

subsubsection {* smap *}

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 {* sfilter *}

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 {* sforall2 *}

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 {* stakewhile *}

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 {* sdropwhile *}

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 {* slast *}

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 {* sconc *}

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 {* sflat *}

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 {* szip *}

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 fastsimp
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