Theory Buffer

Up to index of Isabelle/HOLCF/FOCUS

theory Buffer
imports FOCUS
begin

(*  Title:      HOLCF/FOCUS/Buffer.thy
    ID:         $Id: Buffer.thy,v 1.10 2006/11/17 01:20:34 wenzelm Exp $
    Author:     David von Oheimb, TU Muenchen

Formalization of section 4 of

@inproceedings {broy_mod94,
    author = {Manfred Broy},
    title = {{Specification and Refinement of a Buffer of Length One}},
    booktitle = {Deductive Program Design},
    year = {1994},
    editor = {Manfred Broy},
    volume = {152},
    series = {ASI Series, Series F: Computer and System Sciences},
    pages = {273 -- 304},
    publisher = {Springer}
}

Slides available from http://ddvo.net/talks/1-Buffer.ps.gz

*)

theory Buffer
imports FOCUS
begin

typedecl D

datatype

  M     = Md D | Mreq ("•")

datatype

  State = Sd D | Snil ("¤")

types

  SPF11         = "M fstream -> D fstream"
  SPEC11        = "SPF11 set"
  SPSF11        = "State => SPF11"
  SPECS11       = "SPSF11 set"

definition
  BufEq_F       :: "SPEC11 => SPEC11" where
  "BufEq_F B = {f. ∀d. f·(Md d\<leadsto><>) = <> ∧
                (∀x. ∃ff∈B. f·(Md d\<leadsto>•\<leadsto>x) = d\<leadsto>ff·x)}"

definition
  BufEq         :: "SPEC11" where
  "BufEq = gfp BufEq_F"

definition
  BufEq_alt     :: "SPEC11" where
  "BufEq_alt = gfp (λB. {f. ∀d. f·(Md d\<leadsto><> ) = <> ∧
                         (∃ff∈B. (∀x. f·(Md d\<leadsto>•\<leadsto>x) = d\<leadsto>ff·x))})"

definition
  BufAC_Asm_F   :: " (M fstream set) => (M fstream set)" where
  "BufAC_Asm_F A = {s. s = <> ∨
                  (∃d x. s = Md d\<leadsto>x ∧ (x = <> ∨ (ft·x = Def • ∧ (rt·x)∈A)))}"

definition
  BufAC_Asm     :: " (M fstream set)" where
  "BufAC_Asm = gfp BufAC_Asm_F"

definition
  BufAC_Cmt_F   :: "((M fstream * D fstream) set) =>
                    ((M fstream * D fstream) set)" where
  "BufAC_Cmt_F C = {(s,t). ∀d x.
                           (s = <>         -->     t = <>                 ) ∧
                           (s = Md d\<leadsto><>   -->     t = <>                 ) ∧
                           (s = Md d\<leadsto>•\<leadsto>x --> (ft·t = Def d ∧ (x,rt·t)∈C))}"

definition
  BufAC_Cmt     :: "((M fstream * D fstream) set)" where
  "BufAC_Cmt = gfp BufAC_Cmt_F"

definition
  BufAC         :: "SPEC11" where
  "BufAC = {f. ∀x. x∈BufAC_Asm --> (x,f·x)∈BufAC_Cmt}"

definition
  BufSt_F       :: "SPECS11 => SPECS11" where
  "BufSt_F H = {h. ∀s  . h s      ·<>        = <>         ∧
                                 (∀d x. h ¤     ·(Md d\<leadsto>x) = h (Sd d)·x ∧
                                (∃hh∈H. h (Sd d)·(•   \<leadsto>x) = d\<leadsto>(hh ¤·x)))}"

definition
  BufSt_P       :: "SPECS11" where
  "BufSt_P = gfp BufSt_F"

definition
  BufSt         :: "SPEC11" where
  "BufSt = {f. ∃h∈BufSt_P. f = h ¤}"


lemma set_cong: "!!X. A = B ==> (x:A) = (x:B)"
by (erule subst, rule refl)

ML {*
fun B_prover s tac eqs = prove_goal (the_context ()) s (fn prems => [cut_facts_tac prems 1,
        tac 1, auto_tac (claset(), simpset() addsimps eqs)]);

fun prove_forw  s thm     = B_prover s (dtac (thm RS iffD1)) [];
fun prove_backw s thm eqs = B_prover s (rtac (thm RS iffD2)) eqs;
*}

(**** BufEq *******************************************************************)

lemma mono_BufEq_F: "mono BufEq_F"
by (unfold mono_def BufEq_F_def, fast)

lemmas BufEq_fix = mono_BufEq_F [THEN BufEq_def [THEN eq_reflection, THEN def_gfp_unfold]]

lemma BufEq_unfold: "(f:BufEq) = (!d. f·(Md d\<leadsto><>) = <> &
                 (!x. ? ff:BufEq. f·(Md d\<leadsto>•\<leadsto>x) = d\<leadsto>(ff·x)))"
apply (subst BufEq_fix [THEN set_cong])
apply (unfold BufEq_F_def)
apply (simp)
done

lemma Buf_f_empty: "f:BufEq ==> f·<> = <>"
by (drule BufEq_unfold [THEN iffD1], auto)

lemma Buf_f_d: "f:BufEq ==> f·(Md d\<leadsto><>) = <>"
by (drule BufEq_unfold [THEN iffD1], auto)

lemma Buf_f_d_req:
        "f:BufEq ==> ∃ff. ff:BufEq ∧ f·(Md d\<leadsto>•\<leadsto>x) = d\<leadsto>ff·x"
by (drule BufEq_unfold [THEN iffD1], auto)


(**** BufAC_Asm ***************************************************************)

lemma mono_BufAC_Asm_F: "mono BufAC_Asm_F"
by (unfold mono_def BufAC_Asm_F_def, fast)

lemmas BufAC_Asm_fix =
  mono_BufAC_Asm_F [THEN BufAC_Asm_def [THEN eq_reflection, THEN def_gfp_unfold]]

lemma BufAC_Asm_unfold: "(s:BufAC_Asm) = (s = <> | (? d x. 
        s = Md d\<leadsto>x & (x = <> | (ft·x = Def • & (rt·x):BufAC_Asm))))"
apply (subst BufAC_Asm_fix [THEN set_cong])
apply (unfold BufAC_Asm_F_def)
apply (simp)
done

lemma BufAC_Asm_empty: "<>     :BufAC_Asm"
by (rule BufAC_Asm_unfold [THEN iffD2], auto)

lemma BufAC_Asm_d: "Md d\<leadsto><>:BufAC_Asm"
by (rule BufAC_Asm_unfold [THEN iffD2], auto)
lemma BufAC_Asm_d_req: "x:BufAC_Asm ==> Md d\<leadsto>•\<leadsto>x:BufAC_Asm"
by (rule BufAC_Asm_unfold [THEN iffD2], auto)
lemma BufAC_Asm_prefix2: "a\<leadsto>b\<leadsto>s:BufAC_Asm ==> s:BufAC_Asm"
by (drule BufAC_Asm_unfold [THEN iffD1], auto)


(**** BBufAC_Cmt **************************************************************)

lemma mono_BufAC_Cmt_F: "mono BufAC_Cmt_F"
by (unfold mono_def BufAC_Cmt_F_def, fast)

lemmas BufAC_Cmt_fix =
  mono_BufAC_Cmt_F [THEN BufAC_Cmt_def [THEN eq_reflection, THEN def_gfp_unfold]]

lemma BufAC_Cmt_unfold: "((s,t):BufAC_Cmt) = (!d x. 
     (s = <>       -->      t = <>) & 
     (s = Md d\<leadsto><>  -->      t = <>) & 
     (s = Md d\<leadsto>•\<leadsto>x --> ft·t = Def d & (x, rt·t):BufAC_Cmt))"
apply (subst BufAC_Cmt_fix [THEN set_cong])
apply (unfold BufAC_Cmt_F_def)
apply (simp)
done

lemma BufAC_Cmt_empty: "f:BufEq ==> (<>, f·<>):BufAC_Cmt"
by (rule BufAC_Cmt_unfold [THEN iffD2], auto simp add: Buf_f_empty)

lemma BufAC_Cmt_d: "f:BufEq ==> (a\<leadsto>⊥, f·(a\<leadsto>⊥)):BufAC_Cmt"
by (rule BufAC_Cmt_unfold [THEN iffD2], auto simp add: Buf_f_d)

lemma BufAC_Cmt_d2:
 "(Md d\<leadsto>⊥, f·(Md d\<leadsto>⊥)):BufAC_Cmt ==> f·(Md d\<leadsto>⊥) = ⊥"
by (drule BufAC_Cmt_unfold [THEN iffD1], auto)

lemma BufAC_Cmt_d3:
"(Md d\<leadsto>•\<leadsto>x, f·(Md d\<leadsto>•\<leadsto>x)):BufAC_Cmt ==> (x, rt·(f·(Md d\<leadsto>•\<leadsto>x))):BufAC_Cmt"
by (drule BufAC_Cmt_unfold [THEN iffD1], auto)

lemma BufAC_Cmt_d32:
"(Md d\<leadsto>•\<leadsto>x, f·(Md d\<leadsto>•\<leadsto>x)):BufAC_Cmt ==> ft·(f·(Md d\<leadsto>•\<leadsto>x)) = Def d"
by (drule BufAC_Cmt_unfold [THEN iffD1], auto)

(**** BufAC *******************************************************************)

lemma BufAC_f_d: "f ∈ BufAC ==> f·(Md d\<leadsto>⊥) = ⊥"
apply (unfold BufAC_def)
apply (fast intro: BufAC_Cmt_d2 BufAC_Asm_d)
done

lemma ex_elim_lemma: "(? ff:B. (!x. f·(a\<leadsto>b\<leadsto>x) = d\<leadsto>ff·x)) = 
    ((!x. ft·(f·(a\<leadsto>b\<leadsto>x)) = Def d) & (LAM x. rt·(f·(a\<leadsto>b\<leadsto>x))):B)"
(*  this is an instance (though unification cannot handle this) of
lemma "(? ff:B. (!x. f·x = d\<leadsto>ff·x)) = \
   \((!x. ft·(f·x) = Def d) & (LAM x. rt·(f·x)):B)"*)
apply safe
apply (  rule_tac [2] P="(%x. x:B)" in ssubst)
prefer 3
apply (   assumption)
apply (  rule_tac [2] ext_cfun)
apply (  drule_tac [2] spec)
apply (  drule_tac [2] f="rt" in cfun_arg_cong)
prefer 2
apply (  simp)
prefer 2
apply ( simp)
apply (rule_tac bexI)
apply auto
apply (drule spec)
apply (erule exE)
apply (erule ssubst)
apply (simp)
done

lemma BufAC_f_d_req: "f∈BufAC ==> ∃ff∈BufAC. ∀x. f·(Md d\<leadsto>•\<leadsto>x) = d\<leadsto>ff·x"
apply (unfold BufAC_def)
apply (rule ex_elim_lemma [THEN iffD2])
apply safe
apply  (fast intro: BufAC_Cmt_d32 [THEN Def_maximal]
             monofun_cfun_arg BufAC_Asm_empty [THEN BufAC_Asm_d_req])
apply (auto intro: BufAC_Cmt_d3 BufAC_Asm_d_req)
done


(**** BufSt *******************************************************************)

lemma mono_BufSt_F: "mono BufSt_F"
by (unfold mono_def BufSt_F_def, fast)

lemmas BufSt_P_fix =
  mono_BufSt_F [THEN BufSt_P_def [THEN eq_reflection, THEN def_gfp_unfold]]

lemma BufSt_P_unfold: "(h:BufSt_P) = (!s. h s·<> = <> & 
           (!d x. h ¤     ·(Md d\<leadsto>x)   =    h (Sd d)·x & 
      (? hh:BufSt_P. h (Sd d)·(•\<leadsto>x)   = d\<leadsto>(hh ¤    ·x))))"
apply (subst BufSt_P_fix [THEN set_cong])
apply (unfold BufSt_F_def)
apply (simp)
done

lemma BufSt_P_empty: "h:BufSt_P ==> h s     · <>       = <>"
by (drule BufSt_P_unfold [THEN iffD1], auto)
lemma BufSt_P_d: "h:BufSt_P ==> h  ¤    ·(Md d\<leadsto>x) = h (Sd d)·x"
by (drule BufSt_P_unfold [THEN iffD1], auto)
lemma BufSt_P_d_req: "h:BufSt_P ==> ∃hh∈BufSt_P.
                                          h (Sd d)·(•   \<leadsto>x) = d\<leadsto>(hh ¤    ·x)"
by (drule BufSt_P_unfold [THEN iffD1], auto)


(**** Buf_AC_imp_Eq ***********************************************************)

lemma Buf_AC_imp_Eq: "BufAC ⊆ BufEq"
apply (unfold BufEq_def)
apply (rule gfp_upperbound)
apply (unfold BufEq_F_def)
apply safe
apply  (erule BufAC_f_d)
apply (drule BufAC_f_d_req)
apply (fast)
done


(**** Buf_Eq_imp_AC by coinduction ********************************************)

lemma BufAC_Asm_cong_lemma [rule_format]: "∀s f ff. f∈BufEq --> ff∈BufEq --> 
  s∈BufAC_Asm --> stream_take n·(f·s) = stream_take n·(ff·s)"
apply (induct_tac "n")
apply  (simp)
apply (intro strip)
apply (drule BufAC_Asm_unfold [THEN iffD1])
apply safe
apply   (simp add: Buf_f_empty)
apply  (simp add: Buf_f_d)
apply (drule ft_eq [THEN iffD1])
apply (clarsimp)
apply (drule Buf_f_d_req)+
apply safe
apply (erule ssubst)+
apply (simp (no_asm))
apply (fast)
done

lemma BufAC_Asm_cong: "[|f ∈ BufEq; ff ∈ BufEq; s ∈ BufAC_Asm|] ==> f·s = ff·s"
apply (rule stream.take_lemmas)
apply (erule (2) BufAC_Asm_cong_lemma)
done

lemma Buf_Eq_imp_AC_lemma: "[|f ∈ BufEq; x ∈ BufAC_Asm|] ==> (x, f·x) ∈ BufAC_Cmt"
apply (unfold BufAC_Cmt_def)
apply (rotate_tac)
apply (erule weak_coinduct_image)
apply (unfold BufAC_Cmt_F_def)
apply safe
apply    (erule Buf_f_empty)
apply   (erule Buf_f_d)
apply  (drule Buf_f_d_req)
apply  (clarsimp)
apply  (erule exI)
apply (drule BufAC_Asm_prefix2)
apply (frule Buf_f_d_req)
apply (clarsimp)
apply (erule ssubst)
apply (simp)
apply (drule (2) BufAC_Asm_cong)
apply (erule subst)
apply (erule imageI)
done
lemma Buf_Eq_imp_AC: "BufEq ⊆ BufAC"
apply (unfold BufAC_def)
apply (clarify)
apply (erule (1) Buf_Eq_imp_AC_lemma)
done

(**** Buf_Eq_eq_AC ************************************************************)

lemmas Buf_Eq_eq_AC = Buf_AC_imp_Eq [THEN Buf_Eq_imp_AC [THEN subset_antisym]]


(**** alternative (not strictly) stronger version of Buf_Eq *******************)

lemma Buf_Eq_alt_imp_Eq: "BufEq_alt ⊆ BufEq"
apply (unfold BufEq_def BufEq_alt_def)
apply (rule gfp_mono)
apply (unfold BufEq_F_def)
apply (fast)
done

(* direct proof of "BufEq ⊆ BufEq_alt" seems impossible *)


lemma Buf_AC_imp_Eq_alt: "BufAC <= BufEq_alt"
apply (unfold BufEq_alt_def)
apply (rule gfp_upperbound)
apply (fast elim: BufAC_f_d BufAC_f_d_req)
done

lemmas Buf_Eq_imp_Eq_alt = subset_trans [OF Buf_Eq_imp_AC Buf_AC_imp_Eq_alt]

lemmas Buf_Eq_alt_eq = subset_antisym [OF Buf_Eq_alt_imp_Eq Buf_Eq_imp_Eq_alt]


(**** Buf_Eq_eq_St ************************************************************)

lemma Buf_St_imp_Eq: "BufSt <= BufEq"
apply (unfold BufSt_def BufEq_def)
apply (rule gfp_upperbound)
apply (unfold BufEq_F_def)
apply safe
apply ( simp add: BufSt_P_d BufSt_P_empty)
apply (simp add: BufSt_P_d)
apply (drule BufSt_P_d_req)
apply (force)
done

lemma Buf_Eq_imp_St: "BufEq <= BufSt"
apply (unfold BufSt_def BufSt_P_def)
apply safe
apply (rename_tac f)
apply (rule_tac x="λs. case s of Sd d => Λ x. f·(Md d\<leadsto>x)| ¤ => f" in bexI)
apply ( simp)
apply (erule weak_coinduct_image)
apply (unfold BufSt_F_def)
apply (simp)
apply safe
apply (  rename_tac "s")
apply (  induct_tac "s")
apply (   simp add: Buf_f_d)
apply (  simp add: Buf_f_empty)
apply ( simp)
apply (simp)
apply (rename_tac f d x)
apply (drule_tac d="d" and x="x" in Buf_f_d_req)
apply auto
done

lemmas Buf_Eq_eq_St = Buf_St_imp_Eq [THEN Buf_Eq_imp_St [THEN subset_antisym]]

end

lemma set_cong:

  A = B ==> (xA) = (xB)

lemma mono_BufEq_F:

  mono BufEq_F

lemma BufEq_fix:

  BufEq = BufEq_F BufEq

lemma BufEq_unfold:

  (fBufEq) =
  (∀d. f·(Md d~><>) = <> ∧ (∀x. ∃ffBufEq. f·(Md d~>~>x) = d~>ff·x))

lemma Buf_f_empty:

  fBufEq ==> f·<> = <>

lemma Buf_f_d:

  fBufEq ==> f·(Md d~><>) = <>

lemma Buf_f_d_req:

  fBufEq ==> ∃ff. ffBufEqf·(Md d~>~>x) = d~>ff·x

lemma mono_BufAC_Asm_F:

  mono BufAC_Asm_F

lemma BufAC_Asm_fix:

  BufAC_Asm = BufAC_Asm_F BufAC_Asm

lemma BufAC_Asm_unfold:

  (sBufAC_Asm) =
  (s = <> ∨ (∃d x. s = Md d~>x ∧ (x = <> ∨ ft·x = Def • ∧ rt·xBufAC_Asm)))

lemma BufAC_Asm_empty:

  <>BufAC_Asm

lemma BufAC_Asm_d:

  Md d~><>BufAC_Asm

lemma BufAC_Asm_d_req:

  xBufAC_Asm ==> Md d~>~>xBufAC_Asm

lemma BufAC_Asm_prefix2:

  a~>b~>sBufAC_Asm ==> sBufAC_Asm

lemma mono_BufAC_Cmt_F:

  mono BufAC_Cmt_F

lemma BufAC_Cmt_fix:

  BufAC_Cmt = BufAC_Cmt_F BufAC_Cmt

lemma BufAC_Cmt_unfold:

  ((s, t) ∈ BufAC_Cmt) =
  (∀d x. (s = <> --> t = <>) ∧
         (s = Md d~><> --> t = <>) ∧
         (s = Md d~>~>x --> ft·t = Def d ∧ (x, rt·t) ∈ BufAC_Cmt))

lemma BufAC_Cmt_empty:

  fBufEq ==> (<>, f·<>) ∈ BufAC_Cmt

lemma BufAC_Cmt_d:

  fBufEq ==> (a~><>, f·(a~><>)) ∈ BufAC_Cmt

lemma BufAC_Cmt_d2:

  (Md d~><>, f·(Md d~><>)) ∈ BufAC_Cmt ==> f·(Md d~><>) = <>

lemma BufAC_Cmt_d3:

  (Md d~>~>x, f·(Md d~>~>x)) ∈ BufAC_Cmt
  ==> (x, rt·(f·(Md d~>~>x))) ∈ BufAC_Cmt

lemma BufAC_Cmt_d32:

  (Md d~>~>x, f·(Md d~>~>x)) ∈ BufAC_Cmt ==> ft·(f·(Md d~>~>x)) = Def d

lemma BufAC_f_d:

  fBufAC ==> f·(Md d~><>) = <>

lemma ex_elim_lemma:

  (∃ffB. ∀x. f·(a~>b~>x) = d~>ff·x) =
  ((∀x. ft·(f·(a~>b~>x)) = Def d) ∧ (LAM x. rt·(f·(a~>b~>x))) ∈ B)

lemma BufAC_f_d_req:

  fBufAC ==> ∃ffBufAC. ∀x. f·(Md d~>~>x) = d~>ff·x

lemma mono_BufSt_F:

  mono BufSt_F

lemma BufSt_P_fix:

  BufSt_P = BufSt_F BufSt_P

lemma BufSt_P_unfold:

  (hBufSt_P) =
  (∀s. h s·<> = <> ∧
       (∀d x. h ¤·(Md d~>x) = h (Sd dx ∧
              (∃hhBufSt_P. h (Sd d)·(•~>x) = d~>hh ¤·x)))

lemma BufSt_P_empty:

  hBufSt_P ==> h s·<> = <>

lemma BufSt_P_d:

  hBufSt_P ==> h ¤·(Md d~>x) = h (Sd dx

lemma BufSt_P_d_req:

  hBufSt_P ==> ∃hhBufSt_P. h (Sd d)·(•~>x) = d~>hh ¤·x

lemma Buf_AC_imp_Eq:

  BufAC  BufEq

lemma BufAC_Asm_cong_lemma:

  [| fBufEq; ffBufEq; sBufAC_Asm |]
  ==> stream_take n·(f·s) = stream_take n·(ff·s)

lemma BufAC_Asm_cong:

  [| fBufEq; ffBufEq; sBufAC_Asm |] ==> f·s = ff·s

lemma Buf_Eq_imp_AC_lemma:

  [| fBufEq; xBufAC_Asm |] ==> (x, f·x) ∈ BufAC_Cmt

lemma Buf_Eq_imp_AC:

  BufEq  BufAC

lemma Buf_Eq_eq_AC:

  BufEq = BufAC

lemma Buf_Eq_alt_imp_Eq:

  BufEq_alt  BufEq

lemma Buf_AC_imp_Eq_alt:

  BufAC  BufEq_alt

lemma Buf_Eq_imp_Eq_alt:

  BufEq  BufEq_alt

lemma Buf_Eq_alt_eq:

  BufEq_alt = BufEq

lemma Buf_St_imp_Eq:

  BufSt  BufEq

lemma Buf_Eq_imp_St:

  BufEq  BufSt

lemma Buf_Eq_eq_St:

  BufEq = BufSt