# Theory WellType

Up to index of Isabelle/HOL/MicroJava

theory WellType
imports Term WellForm
begin

    (*  Title:      HOL/MicroJava/J/WellType.thy
        ID:         $Id: WellType.thy,v 1.25 2005/06/17 14:13:09 haftmann Exp $
        Author:     David von Oheimb
        Copyright   1999 Technische Universitaet Muenchen
    *)

    header {* \isaheader{Well-typedness Constraints} *}

    theory WellType imports Term WellForm begin

    text {*
    the formulation of well-typedness of method calls given below (as well as
    the Java Specification 1.0) is a little too restrictive: Is does not allow
    methods of class Object to be called upon references of interface type.

    \begin{description}
    \item[simplifications:]\ \\
    \begin{itemize}
    \item the type rules include all static checks on expressions and statements,
      e.g.\ definedness of names (of parameters, locals, fields, methods)
    \end{itemize}
    \end{description}
    *}

    text "local variables, including method parameters and This:"
    types
      lenv   = "vname \<rightharpoonup> ty"
      'c env = "'c prog × lenv"

    syntax
      prg    :: "'c env => 'c prog"
      localT :: "'c env => (vname \<rightharpoonup> ty)"

    translations
      "prg"    => "fst"
      "localT" => "snd"

    consts
      more_spec :: "'c prog => (ty × 'x) × ty list =>
                    (ty × 'x) × ty list => bool"
      appl_methds :: "'c prog =>  cname => sig => ((ty × ty) × ty list) set"
      max_spec :: "'c prog =>  cname => sig => ((ty × ty) × ty list) set"

    defs
      more_spec_def: "more_spec G == λ((d,h),pTs). λ((d',h'),pTs'). G\<turnstile>d\<preceq>d' ∧
                                    list_all2 (λT T'. G\<turnstile>T\<preceq>T') pTs pTs'"

      -- "applicable methods, cf. 15.11.2.1"
      appl_methds_def: "appl_methds G C == λ(mn, pTs).
                         {((Class md,rT),pTs') |md rT mb pTs'.
                          method (G,C)  (mn, pTs') = Some (md,rT,mb) ∧
                          list_all2 (λT T'. G\<turnstile>T\<preceq>T') pTs pTs'}"

      -- "maximally specific methods, cf. 15.11.2.2"
      max_spec_def: "max_spec G C sig == {m. m ∈appl_methds G C sig ∧
                                           (∀m'∈appl_methds G C sig.
                                             more_spec G m' m --> m' = m)}"

    lemma max_spec2appl_meths:
      "x ∈ max_spec G C sig ==> x ∈ appl_methds G C sig"
    apply (unfold max_spec_def)
    apply (fast)
    done

    lemma appl_methsD:
    "((md,rT),pTs')∈appl_methds G C (mn, pTs) ==>
      ∃D b. md = Class D ∧ method (G,C) (mn, pTs') = Some (D,rT,b)
      ∧ list_all2 (λT T'. G\<turnstile>T\<preceq>T') pTs pTs'"
    apply (unfold appl_methds_def)
    apply (fast)
    done

    lemmas max_spec2mheads = insertI1 [THEN [2] equalityD2 [THEN subsetD],
                             THEN max_spec2appl_meths, THEN appl_methsD]

    consts
      typeof :: "(loc => ty option) => val => ty option"

    primrec
      "typeof dt  Unit    = Some (PrimT Void)"
      "typeof dt  Null    = Some NT"
      "typeof dt (Bool b) = Some (PrimT Boolean)"
      "typeof dt (Intg i) = Some (PrimT Integer)"
      "typeof dt (Addr a) = dt a"

    lemma is_type_typeof [rule_format (no_asm), simp]:
      "(∀a. v ≠ Addr a) --> (∃T. typeof t v = Some T ∧ is_type G T)"
    apply (rule val.induct)
    apply     auto
    done

    lemma typeof_empty_is_type [rule_format (no_asm)]:
      "typeof (λa. None) v = Some T --> is_type G T"
    apply (rule val.induct)
    apply     auto
    done

    lemma typeof_default_val: "∃T. (typeof dt (default_val ty) = Some T) ∧ G\<turnstile> T \<preceq> ty"
    apply (case_tac ty)
    apply (case_tac prim_ty)
    apply auto
    done

    types
      java_mb = "vname list × (vname × ty) list × stmt × expr"
    -- "method body with parameter names, local variables, block, result expression."
    -- "local variables might include This, which is hidden anyway"

    consts
      ty_expr :: "('c env × expr      × ty     ) set"
      ty_exprs:: "('c env × expr list × ty list) set"
      wt_stmt :: "('c env × stmt               ) set"

    syntax (xsymbols)
      ty_expr :: "'c env => [expr     , ty     ] => bool" ("_ \<turnstile> _ :: _"   [51,51,51]50)
      ty_exprs:: "'c env => [expr list, ty list] => bool" ("_ \<turnstile> _ [::] _" [51,51,51]50)
      wt_stmt :: "'c env =>  stmt                => bool" ("_ \<turnstile> _ \<surd>"      [51,51   ]50)

    syntax
      ty_expr :: "'c env => [expr     , ty     ] => bool" ("_ |- _ :: _"   [51,51,51]50)
      ty_exprs:: "'c env => [expr list, ty list] => bool" ("_ |- _ [::] _" [51,51,51]50)
      wt_stmt :: "'c env =>  stmt                => bool" ("_ |- _ [ok]"   [51,51   ]50)

    translations
      "E\<turnstile>e :: T" == "(E,e,T) ∈ ty_expr"
      "E\<turnstile>e[::]T" == "(E,e,T) ∈ ty_exprs"
      "E\<turnstile>c \<surd>"    == "(E,c)   ∈ wt_stmt"

    inductive "ty_expr" "ty_exprs" "wt_stmt" intros

      NewC: "[| is_class (prg E) C |] ==>
             E\<turnstile>NewC C::Class C"  -- "cf. 15.8"

      -- "cf. 15.15"
      Cast: "[| E\<turnstile>e::C; is_class (prg E) D;
                prg E\<turnstile>C\<preceq>? Class D |] ==>
             E\<turnstile>Cast D e:: Class D"

      -- "cf. 15.7.1"
      Lit:    "[| typeof (λv. None) x = Some T |] ==>
             E\<turnstile>Lit x::T"

      -- "cf. 15.13.1"
      LAcc: "[| localT E v = Some T; is_type (prg E) T |] ==>
             E\<turnstile>LAcc v::T"

      BinOp:"[| E\<turnstile>e1::T;
                E\<turnstile>e2::T;
                if bop = Eq then T' = PrimT Boolean
                            else T' = T ∧ T = PrimT Integer|] ==>
                E\<turnstile>BinOp bop e1 e2::T'"

      -- "cf. 15.25, 15.25.1"
      LAss: "[| v ~= This;
                E\<turnstile>LAcc v::T;
                E\<turnstile>e::T';
                prg E\<turnstile>T'\<preceq>T |] ==>
             E\<turnstile>v::=e::T'"

      -- "cf. 15.10.1"
      FAcc: "[| E\<turnstile>a::Class C;
                field (prg E,C) fn = Some (fd,fT) |] ==>
                E\<turnstile>{fd}a..fn::fT"

      -- "cf. 15.25, 15.25.1"
      FAss: "[| E\<turnstile>{fd}a..fn::T;
                E\<turnstile>v        ::T';
                prg E\<turnstile>T'\<preceq>T |] ==>
             E\<turnstile>{fd}a..fn:=v::T'"

      -- "cf. 15.11.1, 15.11.2, 15.11.3"
      Call: "[| E\<turnstile>a::Class C;
                E\<turnstile>ps[::]pTs;
                max_spec (prg E) C (mn, pTs) = {((md,rT),pTs')} |] ==>
             E\<turnstile>{C}a..mn({pTs'}ps)::rT"

    -- "well-typed expression lists"

      -- "cf. 15.11.???"
      Nil: "E\<turnstile>[][::][]"

      -- "cf. 15.11.???"
      Cons:"[| E\<turnstile>e::T;
               E\<turnstile>es[::]Ts |] ==>
            E\<turnstile>e#es[::]T#Ts"

    -- "well-typed statements"

      Skip:"E\<turnstile>Skip\<surd>"

      Expr:"[| E\<turnstile>e::T |] ==>
            E\<turnstile>Expr e\<surd>"

      Comp:"[| E\<turnstile>s1\<surd>;
               E\<turnstile>s2\<surd> |] ==>
            E\<turnstile>s1;; s2\<surd>"

      -- "cf. 14.8"
      Cond:"[| E\<turnstile>e::PrimT Boolean;
               E\<turnstile>s1\<surd>;
               E\<turnstile>s2\<surd> |] ==>
             E\<turnstile>If(e) s1 Else s2\<surd>"

      -- "cf. 14.10"
      Loop:"[| E\<turnstile>e::PrimT Boolean;
               E\<turnstile>s\<surd> |] ==>
            E\<turnstile>While(e) s\<surd>"

    constdefs

     wf_java_mdecl :: "'c prog => cname => java_mb mdecl => bool"
    "wf_java_mdecl G C == λ((mn,pTs),rT,(pns,lvars,blk,res)).
      length pTs = length pns ∧
      distinct pns ∧
      unique lvars ∧
            This ∉ set pns ∧ This ∉ set (map fst lvars) ∧
      (∀pn∈set pns. map_of lvars pn = None) ∧
      (∀(vn,T)∈set lvars. is_type G T) &
      (let E = (G,map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class C)) in
       E\<turnstile>blk\<surd> ∧ (∃T. E\<turnstile>res::T ∧ G\<turnstile>T\<preceq>rT))"

    syntax
     wf_java_prog :: "'c prog => bool"
    translations
      "wf_java_prog" == "wf_prog wf_java_mdecl"

    lemma wf_java_prog_wf_java_mdecl: "[|
      wf_java_prog G; (C, D, fds, mths) ∈ set G; jmdcl ∈ set mths |]
      ==> wf_java_mdecl G C jmdcl"
    apply (simp only: wf_prog_def)
    apply (erule conjE)+
    apply (drule bspec, assumption)
    apply (simp add: wf_cdecl_mdecl_def split_beta)
    done

    lemma wt_is_type: "(E\<turnstile>e::T --> ws_prog (prg E) --> is_type (prg E) T) ∧
           (E\<turnstile>es[::]Ts --> ws_prog (prg E) --> Ball (set Ts) (is_type (prg E))) ∧
           (E\<turnstile>c \<surd> --> True)"
    apply (rule ty_expr_ty_exprs_wt_stmt.induct)
    apply auto
    apply (   erule typeof_empty_is_type)
    apply (  simp split add: split_if_asm)
    apply ( drule field_fields)
    apply ( drule (1) fields_is_type)
    apply (  simp (no_asm_simp))
    apply  (assumption)
    apply (auto dest!: max_spec2mheads method_wf_mhead is_type_rTI
                simp add: wf_mdecl_def)
    done

    lemmas ty_expr_is_type = wt_is_type [THEN conjunct1,THEN mp, rule_format]

    lemma expr_class_is_class: "
      [|ws_prog (prg E); E \<turnstile> e :: Class C|] ==> is_class (prg E) C"
      by (frule ty_expr_is_type, assumption, simp)

    end

lemma max_spec2appl_meths:

      x ∈ max_spec G C sig ==> x ∈ appl_methds G C sig

lemma appl_methsD:

      ((md, rT), pTs') ∈ appl_methds G C (mn, pTs)
      ==> ∃D b. md = Class D ∧
                method (G, C) (mn, pTs') = Some (D, rT, b) ∧
                list_all2 (%T T'. G |- T <= T') pTs pTs'

lemmas max_spec2mheads:

      max_spec G C (mn, pTs) = insert ((md, rT), pTs') B4
      ==> ∃D b. md = Class D ∧
                method (G, C) (mn, pTs') = Some (D, rT, b) ∧
                list_all2 (%T T'. G |- T <= T') pTs pTs'

lemmas max_spec2mheads:

      max_spec G C (mn, pTs) = insert ((md, rT), pTs') B4
      ==> ∃D b. md = Class D ∧
                method (G, C) (mn, pTs') = Some (D, rT, b) ∧
                list_all2 (%T T'. G |- T <= T') pTs pTs'

lemma is_type_typeof:

      ∀a. v ≠ Addr a ==> ∃T. typeof t v = Some T ∧ is_type G T

lemma typeof_empty_is_type:

      typeof empty v = Some T ==> is_type G T

lemma typeof_default_val:

      ∃T. typeof dt (default_val ty) = Some T ∧ G |- T <= ty

lemma wf_java_prog_wf_java_mdecl:

      [| wf_java_prog G; (C, D, fds, mths) ∈ set G; jmdcl ∈ set mths |]
      ==> wf_java_mdecl G C jmdcl

lemma wt_is_type:

      (E |- e :: T --> ws_prog (fst E) --> is_type (fst E) T) ∧
      (E |- es [::] Ts --> ws_prog (fst E) --> Ball (set Ts) (is_type (fst E))) ∧
      (E |- c [ok] --> True)

lemmas ty_expr_is_type:

      [| E |- e :: T; ws_prog (fst E) |] ==> is_type (fst E) T

lemmas ty_expr_is_type:

      [| E |- e :: T; ws_prog (fst E) |] ==> is_type (fst E) T

lemma expr_class_is_class:

      [| ws_prog (fst E); E |- e :: Class C |] ==> is_class (fst E) C