# Theory Pointers0

Up to index of Isabelle/HOL/Hoare

theory Pointers0
imports Hoare
begin

    (*  Title:      HOL/Hoare/Pointers.thy
        ID:         $Id: Pointers0.thy,v 1.3 2005/06/17 14:13:07 haftmann Exp $
        Author:     Tobias Nipkow
        Copyright   2002 TUM

    This is like Pointers.thy, but instead of a type constructor 'a ref
    that adjoins Null to a type, Null is simply a distinguished element of
    the address type. This avoids the Ref constructor and thus simplifies
    specifications (a bit). However, the proofs don't seem to get simpler
    - in fact in some case they appear to get (a bit) more complicated.
    *)

    theory Pointers0 imports Hoare begin

    subsection "References"

    axclass ref < type
    consts Null :: "'a::ref"

    subsection "Field access and update"

    syntax
      "@fassign"  :: "'a::ref => id => 'v => 's com"
       ("(2_^._ :=/ _)" [70,1000,65] 61)
      "@faccess"  :: "'a::ref => ('a::ref => 'v) => 'v"
       ("_^._" [65,1000] 65)
    translations
      "p^.f := e"  =>  "f := fun_upd f p e"
      "p^.f"       =>  "f p"

    text "An example due to Suzuki:"

    lemma "VARS v n
      {distinct[w,x,y,z]}
      w^.v := (1::int); w^.n := x;
      x^.v := 2; x^.n := y;
      y^.v := 3; y^.n := z;
      z^.v := 4; x^.n := z
      {w^.n^.n^.v = 4}"
    by vcg_simp

    section "The heap"

    subsection "Paths in the heap"

    consts
     Path :: "('a::ref => 'a) => 'a => 'a list => 'a => bool"
    primrec
    "Path h x [] y = (x = y)"
    "Path h x (a#as) y = (x ≠ Null ∧ x = a ∧ Path h (h a) as y)"

    lemma [iff]: "Path h Null xs y = (xs = [] ∧ y = Null)"
    apply(case_tac xs)
    apply fastsimp
    apply fastsimp
    done

    lemma [simp]: "a ≠ Null ==> Path h a as z =
     (as = [] ∧ z = a  ∨  (∃bs. as = a#bs ∧ Path h (h a) bs z))"
    apply(case_tac as)
    apply fastsimp
    apply fastsimp
    done

    lemma [simp]: "!!x. Path f x (as@bs) z = (∃y. Path f x as y ∧ Path f y bs z)"
    by(induct as, simp+)

    lemma [simp]: "!!x. u ∉ set as ==> Path (f(u := v)) x as y = Path f x as y"
    by(induct as, simp, simp add:eq_sym_conv)

    subsection "Lists on the heap"

    subsubsection "Relational abstraction"

    constdefs
     List :: "('a::ref => 'a) => 'a => 'a list => bool"
    "List h x as == Path h x as Null"

    lemma [simp]: "List h x [] = (x = Null)"
    by(simp add:List_def)

    lemma [simp]: "List h x (a#as) = (x ≠ Null ∧ x = a ∧ List h (h a) as)"
    by(simp add:List_def)

    lemma [simp]: "List h Null as = (as = [])"
    by(case_tac as, simp_all)

    lemma List_Ref[simp]:
     "a ≠ Null ==> List h a as = (∃bs. as = a#bs ∧ List h (h a) bs)"
    by(case_tac as, simp_all, fast)

    theorem notin_List_update[simp]:
     "!!x. a ∉ set as ==> List (h(a := y)) x as = List h x as"
    apply(induct as)
    apply simp
    apply(clarsimp simp add:fun_upd_apply)
    done

    declare fun_upd_apply[simp del]fun_upd_same[simp] fun_upd_other[simp]

    lemma List_unique: "!!x bs. List h x as ==> List h x bs ==> as = bs"
    by(induct as, simp, clarsimp)

    lemma List_unique1: "List h p as ==> ∃!as. List h p as"
    by(blast intro:List_unique)

    lemma List_app: "!!x. List h x (as@bs) = (∃y. Path h x as y ∧ List h y bs)"
    by(induct as, simp, clarsimp)

    lemma List_hd_not_in_tl[simp]: "List h (h a) as ==> a ∉ set as"
    apply (clarsimp simp add:in_set_conv_decomp)
    apply(frule List_app[THEN iffD1])
    apply(fastsimp dest: List_unique)
    done

    lemma List_distinct[simp]: "!!x. List h x as ==> distinct as"
    apply(induct as, simp)
    apply(fastsimp dest:List_hd_not_in_tl)
    done

    subsection "Functional abstraction"

    constdefs
     islist :: "('a::ref => 'a) => 'a => bool"
    "islist h p == ∃as. List h p as"
     list :: "('a::ref => 'a) => 'a => 'a list"
    "list h p == SOME as. List h p as"

    lemma List_conv_islist_list: "List h p as = (islist h p ∧ as = list h p)"
    apply(simp add:islist_def list_def)
    apply(rule iffI)
    apply(rule conjI)
    apply blast
    apply(subst some1_equality)
      apply(erule List_unique1)
     apply assumption
    apply(rule refl)
    apply simp
    apply(rule someI_ex)
    apply fast
    done

    lemma [simp]: "islist h Null"
    by(simp add:islist_def)

    lemma [simp]: "a ≠ Null ==> islist h a = islist h (h a)"
    by(simp add:islist_def)

    lemma [simp]: "list h Null = []"
    by(simp add:list_def)

    lemma list_Ref_conv[simp]:
     "[| a ≠ Null; islist h (h a) |] ==> list h a = a # list h (h a)"
    apply(insert List_Ref[of _ h])
    apply(fastsimp simp:List_conv_islist_list)
    done

    lemma [simp]: "islist h (h a) ==> a ∉ set(list h (h a))"
    apply(insert List_hd_not_in_tl[of h])
    apply(simp add:List_conv_islist_list)
    done

    lemma list_upd_conv[simp]:
     "islist h p ==> y ∉ set(list h p) ==> list (h(y := q)) p = list h p"
    apply(drule notin_List_update[of _ _ h q p])
    apply(simp add:List_conv_islist_list)
    done

    lemma islist_upd[simp]:
     "islist h p ==> y ∉ set(list h p) ==> islist (h(y := q)) p"
    apply(frule notin_List_update[of _ _ h q p])
    apply(simp add:List_conv_islist_list)
    done

    section "Verifications"

    subsection "List reversal"

    text "A short but unreadable proof:"

    lemma "VARS tl p q r
      {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {}}
      WHILE p ≠ Null
      INV {∃ps qs. List tl p ps ∧ List tl q qs ∧ set ps ∩ set qs = {} ∧
                     rev ps @ qs = rev Ps @ Qs}
      DO r := p; p := p^.tl; r^.tl := q; q := r OD
      {List tl q (rev Ps @ Qs)}"
    apply vcg_simp
      apply fastsimp
     apply(fastsimp intro:notin_List_update[THEN iffD2])
    (* explicily:
     apply clarify
     apply(rename_tac ps qs)
     apply clarsimp
     apply(rename_tac ps')
     apply(rule_tac x = ps' in exI)
     apply simp
     apply(rule_tac x = "p#qs" in exI)
     apply simp
    *)
    apply fastsimp
    done

    text "A longer readable version:"

    lemma "VARS tl p q r
      {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {}}
      WHILE p ≠ Null
      INV {∃ps qs. List tl p ps ∧ List tl q qs ∧ set ps ∩ set qs = {} ∧
                   rev ps @ qs = rev Ps @ Qs}
      DO r := p; p := p^.tl; r^.tl := q; q := r OD
      {List tl q (rev Ps @ Qs)}"
    proof vcg
      fix tl p q r
      assume "List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {}"
      thus "∃ps qs. List tl p ps ∧ List tl q qs ∧ set ps ∩ set qs = {} ∧
                    rev ps @ qs = rev Ps @ Qs" by fastsimp
    next
      fix tl p q r
      assume "(∃ps qs. List tl p ps ∧ List tl q qs ∧ set ps ∩ set qs = {} ∧
                       rev ps @ qs = rev Ps @ Qs) ∧ p ≠ Null"
             (is "(∃ps qs. ?I ps qs) ∧ _")
      then obtain ps qs where I: "?I ps qs ∧ p ≠ Null" by fast
      then obtain ps' where "ps = p # ps'" by fastsimp
      hence "List (tl(p := q)) (p^.tl) ps' ∧
             List (tl(p := q)) p       (p#qs) ∧
             set ps' ∩ set (p#qs) = {} ∧
             rev ps' @ (p#qs) = rev Ps @ Qs"
        using I by fastsimp
      thus "∃ps' qs'. List (tl(p := q)) (p^.tl) ps' ∧
                      List (tl(p := q)) p       qs' ∧
                      set ps' ∩ set qs' = {} ∧
                      rev ps' @ qs' = rev Ps @ Qs" by fast
    next
      fix tl p q r
      assume "(∃ps qs. List tl p ps ∧ List tl q qs ∧ set ps ∩ set qs = {} ∧
                       rev ps @ qs = rev Ps @ Qs) ∧ ¬ p ≠ Null"
      thus "List tl q (rev Ps @ Qs)" by fastsimp
    qed

    text{* Finaly, the functional version. A bit more verbose, but automatic! *}

    lemma "VARS tl p q r
      {islist tl p ∧ islist tl q ∧
       Ps = list tl p ∧ Qs = list tl q ∧ set Ps ∩ set Qs = {}}
      WHILE p ≠ Null
      INV {islist tl p ∧ islist tl q ∧
           set(list tl p) ∩ set(list tl q) = {} ∧
           rev(list tl p) @ (list tl q) = rev Ps @ Qs}
      DO r := p; p := p^.tl; r^.tl := q; q := r OD
      {islist tl q ∧ list tl q = rev Ps @ Qs}"
    apply vcg_simp
      apply clarsimp
     apply clarsimp
    apply clarsimp
    done

    subsection "Searching in a list"

    text{*What follows is a sequence of successively more intelligent proofs that
    a simple loop finds an element in a linked list.

    We start with a proof based on the @{term List} predicate. This means it only
    works for acyclic lists. *}

    lemma "VARS tl p
      {List tl p Ps ∧ X ∈ set Ps}
      WHILE p ≠ Null ∧ p ≠ X
      INV {p ≠ Null ∧ (∃ps. List tl p ps ∧ X ∈ set ps)}
      DO p := p^.tl OD
      {p = X}"
    apply vcg_simp
      apply(case_tac "p = Null")
       apply clarsimp
      apply fastsimp
     apply clarsimp
     apply fastsimp
    apply clarsimp
    done

    text{*Using @{term Path} instead of @{term List} generalizes the correctness
    statement to cyclic lists as well: *}

    lemma "VARS tl p
      {Path tl p Ps X}
      WHILE p ≠ Null ∧ p ≠ X
      INV {∃ps. Path tl p ps X}
      DO p := p^.tl OD
      {p = X}"
    apply vcg_simp
      apply blast
     apply clarsimp
     apply(erule disjE)
      apply clarsimp
     apply fastsimp
    apply clarsimp
    done

    text{*Now it dawns on us that we do not need the list witness at all --- it
    suffices to talk about reachability, i.e.\ we can use relations directly. *}

    lemma "VARS tl p
      {(p,X) ∈ {(x,y). y = tl x & x ≠ Null}^*}
      WHILE p ≠ Null ∧ p ≠ X
      INV {(p,X) ∈ {(x,y). y = tl x & x ≠ Null}^*}
      DO p := p^.tl OD
      {p = X}"
    apply vcg_simp
     apply clarsimp
     apply(erule converse_rtranclE)
      apply simp
     apply(simp)
    apply(fastsimp elim:converse_rtranclE)
    done

    subsection "Merging two lists"

    text"This is still a bit rough, especially the proof."

    consts merge :: "'a list * 'a list * ('a => 'a => bool) => 'a list"

    recdef merge "measure(%(xs,ys,f). size xs + size ys)"
    "merge(x#xs,y#ys,f) = (if f x y then x # merge(xs,y#ys,f)
                                    else y # merge(x#xs,ys,f))"
    "merge(x#xs,[],f) = x # merge(xs,[],f)"
    "merge([],y#ys,f) = y # merge([],ys,f)"
    "merge([],[],f) = []"

    lemma imp_disjCL: "(P|Q --> R) = ((P --> R) ∧ (~P --> Q --> R))"
    by blast

    declare disj_not1[simp del] imp_disjL[simp del] imp_disjCL[simp]

    lemma "VARS hd tl p q r s
     {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {} ∧
      (p ≠ Null ∨ q ≠ Null)}
     IF if q = Null then True else p ~= Null & p^.hd ≤ q^.hd
     THEN r := p; p := p^.tl ELSE r := q; q := q^.tl FI;
     s := r;
     WHILE p ≠ Null ∨ q ≠ Null
     INV {EX rs ps qs. Path tl r rs s ∧ List tl p ps ∧ List tl q qs ∧
          distinct(s # ps @ qs @ rs) ∧ s ≠ Null ∧
          merge(Ps,Qs,λx y. hd x ≤ hd y) =
          rs @ s # merge(ps,qs,λx y. hd x ≤ hd y) ∧
          (tl s = p ∨ tl s = q)}
     DO IF if q = Null then True else p ≠ Null ∧ p^.hd ≤ q^.hd
        THEN s^.tl := p; p := p^.tl ELSE s^.tl := q; q := q^.tl FI;
        s := s^.tl
     OD
     {List tl r (merge(Ps,Qs,λx y. hd x ≤ hd y))}"
    apply vcg_simp

    apply (fastsimp)

    apply clarsimp
    apply(rule conjI)
    apply clarsimp
    apply(simp add:eq_sym_conv)
    apply(rule_tac x = "rs @ [s]" in exI)
    apply simp
    apply(rule_tac x = "bs" in exI)
    apply (fastsimp simp:eq_sym_conv)

    apply clarsimp
    apply(rule conjI)
    apply clarsimp
    apply(rule_tac x = "rs @ [s]" in exI)
    apply simp
    apply(rule_tac x = "bsa" in exI)
    apply(rule conjI)
    apply (simp add:eq_sym_conv)
    apply(rule exI)
    apply(rule conjI)
    apply(rule_tac x = bs in exI)
    apply(rule conjI)
    apply(rule refl)
    apply (simp add:eq_sym_conv)
    apply (simp add:eq_sym_conv)

    apply(rule conjI)
    apply clarsimp
    apply(rule_tac x = "rs @ [s]" in exI)
    apply simp
    apply(rule_tac x = bs in exI)
    apply (simp add:eq_sym_conv)
    apply clarsimp
    apply(rule_tac x = "rs @ [s]" in exI)
    apply (simp add:eq_sym_conv)
    apply(rule exI)
    apply(rule conjI)
    apply(rule_tac x = bsa in exI)
    apply(rule conjI)
    apply(rule refl)
    apply (simp add:eq_sym_conv)
    apply(rule_tac x = bs in exI)
    apply (simp add:eq_sym_conv)

    apply(clarsimp simp add:List_app)
    done

    (* TODO: merging with islist/list instead of List: an improvement?
       needs (is)path, which is not so easy to prove either. *)

    subsection "Storage allocation"

    constdefs new :: "'a set => 'a::ref"
    "new A == SOME a. a ∉ A & a ≠ Null"

    lemma new_notin:
     "[| ~finite(UNIV::('a::ref)set); finite(A::'a set); B ⊆ A |] ==>
      new (A) ∉ B & new A ≠ Null"
    apply(unfold new_def)
    apply(rule someI2_ex)
     apply (fast dest:ex_new_if_finite[of "insert Null A"])
    apply (fast)
    done

    lemma "~finite(UNIV::('a::ref)set) ==>
      VARS xs elem next alloc p q
      {Xs = xs ∧ p = (Null::'a)}
      WHILE xs ≠ []
      INV {islist next p ∧ set(list next p) ⊆ set alloc ∧
           map elem (rev(list next p)) @ xs = Xs}
      DO q := new(set alloc); alloc := q#alloc;
         q^.next := p; q^.elem := hd xs; xs := tl xs; p := q
      OD
      {islist next p ∧ map elem (rev(list next p)) = Xs}"
    apply vcg_simp
     apply (clarsimp simp: subset_insert_iff neq_Nil_conv fun_upd_apply new_notin)
    apply fastsimp
    done

    end

### References

### Field access and update

lemma

      {distinct [w, x, y, z]}
       v := v(w := 1);
       n := n(w := x);
       v := v(x := 2);
       n := n(x := y); v := v(y := 3); n := n(y := z); v := v(z := 4); n := n(x := z)
       {v (n (n w)) = 4}

## The heap

### Paths in the heap

lemma

      Path h Null xs y = (xs = [] ∧ y = Null)

lemma

      a ≠ Null
      ==> Path h a as z = (as = [] ∧ z = a ∨ (∃bs. as = a # bs ∧ Path h (h a) bs z))

lemma

      Path f x (as @ bs) z = (∃y. Path f x as y ∧ Path f y bs z)

lemma

      u ∉ set as ==> Path (f(u := v)) x as y = Path f x as y

### Lists on the heap

#### Relational abstraction

lemma

      List h x [] = (x = Null)

lemma

      List h x (a # as) = (x ≠ Null ∧ x = a ∧ List h (h a) as)

lemma

      List h Null as = (as = [])

lemma List_Ref:

      a ≠ Null ==> List h a as = (∃bs. as = a # bs ∧ List h (h a) bs)

theorem notin_List_update:

      a ∉ set as ==> List (h(a := y)) x as = List h x as

lemma List_unique:

      [| List h x as; List h x bs |] ==> as = bs

lemma List_unique1:

      List h p as ==> ∃!as. List h p as

lemma List_app:

      List h x (as @ bs) = (∃y. Path h x as y ∧ List h y bs)

lemma List_hd_not_in_tl:

      List h (h a) as ==> a ∉ set as

lemma List_distinct:

      List h x as ==> distinct as

### Functional abstraction

lemma List_conv_islist_list:

      List h p as = (islist h p ∧ as = list h p)

lemma

      islist h Null

lemma

      a ≠ Null ==> islist h a = islist h (h a)

lemma

      list h Null = []

lemma list_Ref_conv:

      [| a ≠ Null; islist h (h a) |] ==> list h a = a # list h (h a)

lemma

      islist h (h a) ==> a ∉ set (list h (h a))

lemma list_upd_conv:

      [| islist h p; y ∉ set (list h p) |] ==> list (h(y := q)) p = list h p

lemma islist_upd:

      [| islist h p; y ∉ set (list h p) |] ==> islist (h(y := q)) p

## Verifications

### List reversal

lemma

      {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {}}
       WHILE p ≠ Null
        INV {∃ps qs.
                List tl p ps ∧
                List tl q qs ∧ set ps ∩ set qs = {} ∧ rev ps @ qs = rev Ps @ Qs}
        DO r := p; p := tl p; tl := tl(r := q); q := r OD
       {List tl q (rev Ps @ Qs)}

lemma

      {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {}}
       WHILE p ≠ Null
        INV {∃ps qs.
                List tl p ps ∧
                List tl q qs ∧ set ps ∩ set qs = {} ∧ rev ps @ qs = rev Ps @ Qs}
        DO r := p; p := tl p; tl := tl(r := q); q := r OD
       {List tl q (rev Ps @ Qs)}

lemma

      {islist tl p ∧
       islist tl q ∧ Ps = list tl p ∧ Qs = list tl q ∧ set Ps ∩ set Qs = {}}
       WHILE p ≠ Null
        INV {islist tl p ∧
             islist tl q ∧
             set (list tl p) ∩ set (list tl q) = {} ∧
             rev (list tl p) @ list tl q = rev Ps @ Qs}
        DO r := p; p := tl p; tl := tl(r := q); q := r OD
       {islist tl q ∧ list tl q = rev Ps @ Qs}

### Searching in a list

lemma

      {List tl p Ps ∧ X ∈ set Ps}
       WHILE p ≠ Null ∧ p ≠ X INV {p ≠ Null ∧ (∃ps. List tl p ps ∧ X ∈ set ps)}
        DO p := tl p OD
       {p = X}

lemma

      {Path tl p Ps X}
       WHILE p ≠ Null ∧ p ≠ X INV {∃ps. Path tl p ps X}
        DO p := tl p OD
       {p = X}

lemma

      {(p, X) ∈ {(x, y). y = tl x ∧ x ≠ Null}*}
       WHILE p ≠ Null ∧ p ≠ X INV {(p, X) ∈ {(x, y). y = tl x ∧ x ≠ Null}*}
        DO p := tl p OD
       {p = X}

### Merging two lists

lemma imp_disjCL:

      (P ∨ Q --> R) = ((P --> R) ∧ (¬ P --> Q --> R))

lemma

      {List tl p Ps ∧ List tl q Qs ∧ set Ps ∩ set Qs = {} ∧ (p ≠ Null ∨ q ≠ Null)}
       IF if q = Null then True else p ≠ Null ∧ hd p ≤ hd q THEN r := p; p := tl p
        ELSE r := q; q := tl q FI;
       s := r;
       WHILE p ≠ Null ∨ q ≠ Null
        INV {∃rs ps qs.
                Path tl r rs s ∧
                List tl p ps ∧
                List tl q qs ∧
                distinct (s # ps @ qs @ rs) ∧
                s ≠ Null ∧
                merge (Ps, Qs, %x y. hd x ≤ hd y) =
                rs @ s # merge (ps, qs, %x y. hd x ≤ hd y) ∧
                (tl s = p ∨ tl s = q)}
        DO IF if q = Null then True else p ≠ Null ∧ hd p ≤ hd q
            THEN tl := tl(s := p); p := tl p  ELSE tl := tl(s := q); q := tl q FI;
           s := tl s
        OD
       {List tl r (merge (Ps, Qs, %x y. hd x ≤ hd y))}

### Storage allocation

lemma new_notin:

      [| infinite UNIV; finite A; B ⊆ A |] ==> new A ∉ B ∧ new A ≠ Null

lemma

      infinite UNIV
      ==> {Xs = xs ∧ p = Null}
           WHILE xs ≠ []
            INV {islist next p ∧
                 set (list next p) ⊆ set alloc ∧
                 map elem (rev (list next p)) @ xs = Xs}
            DO q := new (set alloc);
               alloc := q # alloc;
               next := next(q := p); elem := elem(q := hd xs); xs := tl xs; p := q
            OD
           {islist next p ∧ map elem (rev (list next p)) = Xs}