417 lines
25 KiB
Plaintext
417 lines
25 KiB
Plaintext
(******************************************************************************
|
|
* Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
|
|
* for the OMG Standard.
|
|
* http://www.brucker.ch/projects/hol-testgen/
|
|
*
|
|
* This file is part of HOL-TestGen.
|
|
*
|
|
* Copyright (c) 2011-2018 Université Paris-Saclay, Univ. Paris-Sud, France
|
|
* 2013-2017 IRT SystemX, France
|
|
* 2011-2015 Achim D. Brucker, Germany
|
|
* 2016-2018 The University of Sheffield, UK
|
|
* 2016-2017 Nanyang Technological University, Singapore
|
|
* 2017-2018 Virginia Tech, USA
|
|
*
|
|
* All rights reserved.
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
*
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following
|
|
* disclaimer in the documentation and/or other materials provided
|
|
* with the distribution.
|
|
*
|
|
* * Neither the name of the copyright holders nor the names of its
|
|
* contributors may be used to endorse or promote products derived
|
|
* from this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
******************************************************************************)
|
|
|
|
theory UML_Contracts
|
|
imports UML_State
|
|
begin
|
|
|
|
text{* Modeling of an operation contract for an operation with 2 arguments,
|
|
(so depending on three parameters if one takes "self" into account). *}
|
|
|
|
locale contract_scheme =
|
|
fixes f_\<upsilon>
|
|
fixes f_lam
|
|
fixes f :: "('\<AA>,'\<alpha>0::null)val \<Rightarrow>
|
|
'b \<Rightarrow>
|
|
('\<AA>,'res::null)val"
|
|
fixes PRE
|
|
fixes POST
|
|
assumes def_scheme': "f self x \<equiv> (\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in
|
|
if (\<tau> \<Turnstile> (\<delta> self)) \<and> f_\<upsilon> x \<tau>
|
|
then (\<tau> \<Turnstile> PRE self x) \<and>
|
|
(\<tau> \<Turnstile> POST self x res)
|
|
else \<tau> \<Turnstile> res \<triangleq> invalid)"
|
|
assumes all_post': "\<forall> \<sigma> \<sigma>' \<sigma>''. ((\<sigma>,\<sigma>') \<Turnstile> PRE self x) = ((\<sigma>,\<sigma>'') \<Turnstile> PRE self x)"
|
|
(* PRE is really a pre-condition semantically,
|
|
i.e. it does not depend on the post-state. ... *)
|
|
assumes cp\<^sub>P\<^sub>R\<^sub>E': "PRE (self) x \<tau> = PRE (\<lambda> _. self \<tau>) (f_lam x \<tau>) \<tau> "
|
|
(* this interface is preferable than :
|
|
assumes "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) )"
|
|
which is too polymorphic. *)
|
|
assumes cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T':"POST (self) x (res) \<tau> = POST (\<lambda> _. self \<tau>) (f_lam x \<tau>) (\<lambda> _. res \<tau>) \<tau>"
|
|
assumes f_\<upsilon>_val: "\<And>a1. f_\<upsilon> (f_lam a1 \<tau>) \<tau> = f_\<upsilon> a1 \<tau>"
|
|
begin
|
|
lemma strict0 [simp]: "f invalid X = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma nullstrict0[simp]: "f null X = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme' StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma cp0 : "f self a1 \<tau> = f (\<lambda> _. self \<tau>) (f_lam a1 \<tau>) \<tau>"
|
|
proof -
|
|
have A: "(\<tau> \<Turnstile> \<delta> (\<lambda>_. self \<tau>)) = (\<tau> \<Turnstile> \<delta> self)" by(simp add: OclValid_def cp_defined[symmetric])
|
|
have B: "f_\<upsilon> (f_lam a1 \<tau>) \<tau> = f_\<upsilon> a1 \<tau>" by (rule f_\<upsilon>_val)
|
|
have D: "(\<tau> \<Turnstile> PRE (\<lambda>_. self \<tau>) (f_lam a1 \<tau>)) = ( \<tau> \<Turnstile> PRE self a1 )"
|
|
by(simp add: OclValid_def cp\<^sub>P\<^sub>R\<^sub>E'[symmetric])
|
|
show ?thesis
|
|
apply(auto simp: def_scheme' A B D)
|
|
apply(simp add: OclValid_def)
|
|
by(subst cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T', simp)
|
|
qed
|
|
|
|
theorem unfold' :
|
|
assumes context_ok: "cp E"
|
|
and args_def_or_valid: "(\<tau> \<Turnstile> \<delta> self) \<and> f_\<upsilon> a1 \<tau>"
|
|
and pre_satisfied: "\<tau> \<Turnstile> PRE self a1"
|
|
and post_satisfiable: " \<exists>res. (\<tau> \<Turnstile> POST self a1 (\<lambda> _. res))"
|
|
and sat_for_sols_post: "(\<And>res. \<tau> \<Turnstile> POST self a1 (\<lambda> _. res) \<Longrightarrow> \<tau> \<Turnstile> E (\<lambda> _. res))"
|
|
shows "\<tau> \<Turnstile> E(f self a1)"
|
|
proof -
|
|
have cp0: "\<And> X \<tau>. E X \<tau> = E (\<lambda>_. X \<tau>) \<tau>" by(insert context_ok[simplified cp_def], auto)
|
|
show ?thesis
|
|
apply(simp add: OclValid_def, subst cp0, fold OclValid_def)
|
|
apply(simp add:def_scheme' args_def_or_valid pre_satisfied)
|
|
apply(insert post_satisfiable, elim exE)
|
|
apply(rule Hilbert_Choice.someI2, assumption)
|
|
by(rule sat_for_sols_post, simp)
|
|
qed
|
|
|
|
lemma unfold2' :
|
|
assumes context_ok: "cp E"
|
|
and args_def_or_valid: "(\<tau> \<Turnstile> \<delta> self) \<and> (f_\<upsilon> a1 \<tau>)"
|
|
and pre_satisfied: "\<tau> \<Turnstile> PRE self a1"
|
|
and postsplit_satisfied: "\<tau> \<Turnstile> POST' self a1" (* split constraint holds on post-state *)
|
|
and post_decomposable : "\<And> res. (POST self a1 res) =
|
|
((POST' self a1) and (res \<triangleq> (BODY self a1)))"
|
|
shows "(\<tau> \<Turnstile> E(f self a1)) = (\<tau> \<Turnstile> E(BODY self a1))"
|
|
proof -
|
|
have cp0: "\<And> X \<tau>. E X \<tau> = E (\<lambda>_. X \<tau>) \<tau>" by(insert context_ok[simplified cp_def], auto)
|
|
show ?thesis
|
|
apply(simp add: OclValid_def, subst cp0, fold OclValid_def)
|
|
apply(simp add:def_scheme' args_def_or_valid pre_satisfied
|
|
post_decomposable postsplit_satisfied foundation10')
|
|
apply(subst some_equality)
|
|
apply(simp add: OclValid_def StrongEq_def true_def)+
|
|
by(subst (2) cp0, rule refl)
|
|
qed
|
|
end
|
|
|
|
|
|
locale contract0 =
|
|
fixes f :: "('\<AA>,'\<alpha>0::null)val \<Rightarrow>
|
|
('\<AA>,'res::null)val"
|
|
fixes PRE
|
|
fixes POST
|
|
assumes def_scheme: "f self \<equiv> (\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in
|
|
if (\<tau> \<Turnstile> (\<delta> self))
|
|
then (\<tau> \<Turnstile> PRE self) \<and>
|
|
(\<tau> \<Turnstile> POST self res)
|
|
else \<tau> \<Turnstile> res \<triangleq> invalid)"
|
|
assumes all_post: "\<forall> \<sigma> \<sigma>' \<sigma>''. ((\<sigma>,\<sigma>') \<Turnstile> PRE self) = ((\<sigma>,\<sigma>'') \<Turnstile> PRE self)"
|
|
(* PRE is really a pre-condition semantically,
|
|
i.e. it does not depend on the post-state. ... *)
|
|
assumes cp\<^sub>P\<^sub>R\<^sub>E: "PRE (self) \<tau> = PRE (\<lambda> _. self \<tau>) \<tau> "
|
|
(* this interface is preferable than :
|
|
assumes "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) )"
|
|
which is too polymorphic. *)
|
|
assumes cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T:"POST (self) (res) \<tau> = POST (\<lambda> _. self \<tau>) (\<lambda> _. res \<tau>) \<tau>"
|
|
|
|
sublocale contract0 < contract_scheme "\<lambda>_ _. True" "\<lambda>x _. x" "\<lambda>x _. f x" "\<lambda>x _. PRE x" "\<lambda>x _. POST x"
|
|
apply(unfold_locales)
|
|
apply(simp add: def_scheme, rule all_post, rule cp\<^sub>P\<^sub>R\<^sub>E, rule cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
by simp
|
|
|
|
context contract0
|
|
begin
|
|
lemma cp_pre: "cp self' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) )"
|
|
by(rule_tac f=PRE in cpI1, auto intro: cp\<^sub>P\<^sub>R\<^sub>E)
|
|
|
|
lemma cp_post: "cp self' \<Longrightarrow> cp res' \<Longrightarrow> cp (\<lambda>X. POST (self' X) (res' X))"
|
|
by(rule_tac f=POST in cpI2, auto intro: cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
|
|
lemma cp [simp]: "cp self' \<Longrightarrow> cp res' \<Longrightarrow> cp (\<lambda>X. f (self' X) )"
|
|
by(rule_tac f=f in cpI1, auto intro:cp0)
|
|
|
|
lemmas unfold = unfold'[simplified]
|
|
|
|
lemma unfold2 :
|
|
assumes "cp E"
|
|
and "(\<tau> \<Turnstile> \<delta> self)"
|
|
and "\<tau> \<Turnstile> PRE self"
|
|
and "\<tau> \<Turnstile> POST' self" (* split constraint holds on post-state *)
|
|
and "\<And> res. (POST self res) =
|
|
((POST' self) and (res \<triangleq> (BODY self)))"
|
|
shows "(\<tau> \<Turnstile> E(f self)) = (\<tau> \<Turnstile> E(BODY self))"
|
|
apply(rule unfold2'[simplified])
|
|
by((rule assms)+)
|
|
|
|
end
|
|
|
|
locale contract1 =
|
|
fixes f :: "('\<AA>,'\<alpha>0::null)val \<Rightarrow>
|
|
('\<AA>,'\<alpha>1::null)val \<Rightarrow>
|
|
('\<AA>,'res::null)val"
|
|
fixes PRE
|
|
fixes POST
|
|
assumes def_scheme: "f self a1 \<equiv>
|
|
(\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in
|
|
if (\<tau> \<Turnstile> (\<delta> self)) \<and> (\<tau> \<Turnstile> \<upsilon> a1)
|
|
then (\<tau> \<Turnstile> PRE self a1) \<and>
|
|
(\<tau> \<Turnstile> POST self a1 res)
|
|
else \<tau> \<Turnstile> res \<triangleq> invalid) "
|
|
assumes all_post: "\<forall> \<sigma> \<sigma>' \<sigma>''. ((\<sigma>,\<sigma>') \<Turnstile> PRE self a1) = ((\<sigma>,\<sigma>'') \<Turnstile> PRE self a1)"
|
|
(* PRE is really a pre-condition semantically,
|
|
i.e. it does not depend on the post-state. ... *)
|
|
assumes cp\<^sub>P\<^sub>R\<^sub>E: "PRE (self) (a1) \<tau> = PRE (\<lambda> _. self \<tau>) (\<lambda> _. a1 \<tau>) \<tau> "
|
|
(* this interface is preferable than :
|
|
assumes "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) )"
|
|
which is too polymorphic. *)
|
|
assumes cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T:"POST (self) (a1) (res) \<tau> = POST (\<lambda> _. self \<tau>)(\<lambda> _. a1 \<tau>) (\<lambda> _. res \<tau>) \<tau>"
|
|
|
|
sublocale contract1 < contract_scheme "\<lambda>a1 \<tau>. (\<tau> \<Turnstile> \<upsilon> a1)" "\<lambda>a1 \<tau>. (\<lambda> _. a1 \<tau>)"
|
|
apply(unfold_locales)
|
|
apply(rule def_scheme, rule all_post, rule cp\<^sub>P\<^sub>R\<^sub>E, rule cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
by(simp add: OclValid_def cp_valid[symmetric])
|
|
|
|
context contract1
|
|
begin
|
|
lemma strict1[simp]: "f self invalid = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma defined_mono : "\<tau> \<Turnstile>\<upsilon>(f Y Z) \<Longrightarrow> (\<tau> \<Turnstile>\<delta> Y) \<and> (\<tau> \<Turnstile>\<upsilon> Z)"
|
|
by(auto simp: valid_def bot_fun_def invalid_def
|
|
def_scheme StrongEq_def OclValid_def false_def true_def
|
|
split: if_split_asm)
|
|
|
|
lemma cp_pre: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) )"
|
|
by(rule_tac f=PRE in cpI2, auto intro: cp\<^sub>P\<^sub>R\<^sub>E)
|
|
|
|
lemma cp_post: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp res'
|
|
\<Longrightarrow> cp (\<lambda>X. POST (self' X) (a1' X) (res' X))"
|
|
by(rule_tac f=POST in cpI3, auto intro: cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
|
|
lemma cp [simp]: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp res' \<Longrightarrow> cp (\<lambda>X. f (self' X) (a1' X))"
|
|
by(rule_tac f=f in cpI2, auto intro:cp0)
|
|
|
|
lemmas unfold = unfold'
|
|
lemmas unfold2 = unfold2'
|
|
end
|
|
|
|
locale contract2 =
|
|
fixes f :: "('\<AA>,'\<alpha>0::null)val \<Rightarrow>
|
|
('\<AA>,'\<alpha>1::null)val \<Rightarrow> ('\<AA>,'\<alpha>2::null)val \<Rightarrow>
|
|
('\<AA>,'res::null)val"
|
|
fixes PRE
|
|
fixes POST
|
|
assumes def_scheme: "f self a1 a2 \<equiv>
|
|
(\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in
|
|
if (\<tau> \<Turnstile> (\<delta> self)) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2)
|
|
then (\<tau> \<Turnstile> PRE self a1 a2) \<and>
|
|
(\<tau> \<Turnstile> POST self a1 a2 res)
|
|
else \<tau> \<Turnstile> res \<triangleq> invalid) "
|
|
assumes all_post: "\<forall> \<sigma> \<sigma>' \<sigma>''. ((\<sigma>,\<sigma>') \<Turnstile> PRE self a1 a2) = ((\<sigma>,\<sigma>'') \<Turnstile> PRE self a1 a2)"
|
|
(* PRE is really a pre-condition semantically,
|
|
i.e. it does not depend on the post-state. ... *)
|
|
assumes cp\<^sub>P\<^sub>R\<^sub>E: "PRE (self) (a1) (a2) \<tau> = PRE (\<lambda> _. self \<tau>) (\<lambda> _. a1 \<tau>) (\<lambda> _. a2 \<tau>) \<tau> "
|
|
(* this interface is preferable than :
|
|
assumes "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) )"
|
|
which is too polymorphic. *)
|
|
assumes cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T:"\<And>res. POST (self) (a1) (a2) (res) \<tau> =
|
|
POST (\<lambda> _. self \<tau>)(\<lambda> _. a1 \<tau>)(\<lambda> _. a2 \<tau>) (\<lambda> _. res \<tau>) \<tau>"
|
|
|
|
|
|
sublocale contract2 < contract_scheme "\<lambda>(a1,a2) \<tau>. (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2)"
|
|
"\<lambda>(a1,a2) \<tau>. (\<lambda> _.a1 \<tau>, \<lambda> _.a2 \<tau>)"
|
|
"(\<lambda>x (a,b). f x a b)"
|
|
"(\<lambda>x (a,b). PRE x a b)"
|
|
"(\<lambda>x (a,b). POST x a b)"
|
|
apply(unfold_locales)
|
|
apply(auto simp add: def_scheme)
|
|
apply (metis all_post, metis all_post)
|
|
apply(subst cp\<^sub>P\<^sub>R\<^sub>E, simp)
|
|
apply(subst cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T, simp)
|
|
by(simp_all add: OclValid_def cp_valid[symmetric])
|
|
|
|
context contract2
|
|
begin
|
|
lemma strict0'[simp] : "f invalid X Y = invalid"
|
|
by(insert strict0[of "(X,Y)"], simp)
|
|
|
|
lemma nullstrict0'[simp]: "f null X Y = invalid"
|
|
by(insert nullstrict0[of "(X,Y)"], simp)
|
|
|
|
lemma strict1[simp]: "f self invalid Y = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma strict2[simp]: "f self X invalid = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma defined_mono : "\<tau> \<Turnstile>\<upsilon>(f X Y Z) \<Longrightarrow> (\<tau> \<Turnstile>\<delta> X) \<and> (\<tau> \<Turnstile>\<upsilon> Y) \<and> (\<tau> \<Turnstile>\<upsilon> Z)"
|
|
by(auto simp: valid_def bot_fun_def invalid_def
|
|
def_scheme StrongEq_def OclValid_def false_def true_def
|
|
split: if_split_asm)
|
|
|
|
lemma cp_pre: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) )"
|
|
by(rule_tac f=PRE in cpI3, auto intro: cp\<^sub>P\<^sub>R\<^sub>E)
|
|
|
|
lemma cp_post: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp res'
|
|
\<Longrightarrow> cp (\<lambda>X. POST (self' X) (a1' X) (a2' X) (res' X))"
|
|
by(rule_tac f=POST in cpI4, auto intro: cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
|
|
lemma cp0' : "f self a1 a2 \<tau> = f (\<lambda> _. self \<tau>) (\<lambda> _. a1 \<tau>) (\<lambda> _. a2 \<tau>) \<tau>"
|
|
by (rule cp0[of _ "(a1,a2)", simplified])
|
|
|
|
lemma cp [simp]: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp res'
|
|
\<Longrightarrow> cp (\<lambda>X. f (self' X) (a1' X) (a2' X))"
|
|
by(rule_tac f=f in cpI3, auto intro:cp0')
|
|
|
|
theorem unfold :
|
|
assumes "cp E"
|
|
and "(\<tau> \<Turnstile> \<delta> self) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2)"
|
|
and "\<tau> \<Turnstile> PRE self a1 a2"
|
|
and " \<exists>res. (\<tau> \<Turnstile> POST self a1 a2 (\<lambda> _. res))"
|
|
and "(\<And>res. \<tau> \<Turnstile> POST self a1 a2 (\<lambda> _. res) \<Longrightarrow> \<tau> \<Turnstile> E (\<lambda> _. res))"
|
|
shows "\<tau> \<Turnstile> E(f self a1 a2)"
|
|
apply(rule unfold'[of _ _ _ "(a1, a2)", simplified])
|
|
by((rule assms)+)
|
|
|
|
lemma unfold2 :
|
|
assumes "cp E"
|
|
and "(\<tau> \<Turnstile> \<delta> self) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2)"
|
|
and "\<tau> \<Turnstile> PRE self a1 a2"
|
|
and "\<tau> \<Turnstile> POST' self a1 a2" (* split constraint holds on post-state *)
|
|
and "\<And> res. (POST self a1 a2 res) =
|
|
((POST' self a1 a2) and (res \<triangleq> (BODY self a1 a2)))"
|
|
shows "(\<tau> \<Turnstile> E(f self a1 a2)) = (\<tau> \<Turnstile> E(BODY self a1 a2))"
|
|
apply(rule unfold2'[of _ _ _ "(a1, a2)", simplified])
|
|
by((rule assms)+)
|
|
end
|
|
|
|
locale contract3 =
|
|
fixes f :: "('\<AA>,'\<alpha>0::null)val \<Rightarrow>
|
|
('\<AA>,'\<alpha>1::null)val \<Rightarrow>
|
|
('\<AA>,'\<alpha>2::null)val \<Rightarrow>
|
|
('\<AA>,'\<alpha>3::null)val \<Rightarrow>
|
|
('\<AA>,'res::null)val"
|
|
fixes PRE
|
|
fixes POST
|
|
assumes def_scheme: "f self a1 a2 a3 \<equiv>
|
|
(\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in
|
|
if (\<tau> \<Turnstile> (\<delta> self)) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2) \<and> (\<tau> \<Turnstile> \<upsilon> a3)
|
|
then (\<tau> \<Turnstile> PRE self a1 a2 a3) \<and>
|
|
(\<tau> \<Turnstile> POST self a1 a2 a3 res)
|
|
else \<tau> \<Turnstile> res \<triangleq> invalid) "
|
|
assumes all_post: "\<forall> \<sigma> \<sigma>' \<sigma>''. ((\<sigma>,\<sigma>') \<Turnstile> PRE self a1 a2 a3) = ((\<sigma>,\<sigma>'') \<Turnstile> PRE self a1 a2 a3)"
|
|
(* PRE is really a pre-condition semantically,
|
|
i.e. it does not depend on the post-state. ... *)
|
|
assumes cp\<^sub>P\<^sub>R\<^sub>E: "PRE (self) (a1) (a2) (a3) \<tau> = PRE (\<lambda> _. self \<tau>) (\<lambda> _. a1 \<tau>) (\<lambda> _. a2 \<tau>) (\<lambda> _. a3 \<tau>) \<tau> "
|
|
(* this interface is preferable than :
|
|
assumes "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp a3' \<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) (a3' X) )"
|
|
which is too polymorphic. *)
|
|
assumes cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T:"\<And>res. POST (self) (a1) (a2) (a3) (res) \<tau> =
|
|
POST (\<lambda> _. self \<tau>)(\<lambda> _. a1 \<tau>)(\<lambda> _. a2 \<tau>)(\<lambda> _. a3 \<tau>) (\<lambda> _. res \<tau>) \<tau>"
|
|
|
|
|
|
sublocale contract3 < contract_scheme "\<lambda>(a1,a2,a3) \<tau>. (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2)\<and> (\<tau> \<Turnstile> \<upsilon> a3)"
|
|
"\<lambda>(a1,a2,a3) \<tau>. (\<lambda> _.a1 \<tau>, \<lambda> _.a2 \<tau>, \<lambda> _.a3 \<tau>)"
|
|
"(\<lambda>x (a,b,c). f x a b c)"
|
|
"(\<lambda>x (a,b,c). PRE x a b c)"
|
|
"(\<lambda>x (a,b,c). POST x a b c)"
|
|
apply(unfold_locales)
|
|
apply(auto simp add: def_scheme)
|
|
apply (metis all_post, metis all_post)
|
|
apply(subst cp\<^sub>P\<^sub>R\<^sub>E, simp)
|
|
apply(subst cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T, simp)
|
|
by(simp_all add: OclValid_def cp_valid[symmetric])
|
|
|
|
context contract3
|
|
begin
|
|
lemma strict0'[simp] : "f invalid X Y Z = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma nullstrict0'[simp]: "f null X Y Z = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma strict1[simp]: "f self invalid Y Z = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma strict2[simp]: "f self X invalid Z = invalid"
|
|
by(rule ext, rename_tac "\<tau>", simp add: def_scheme StrongEq_def OclValid_def false_def true_def)
|
|
|
|
lemma defined_mono : "\<tau> \<Turnstile>\<upsilon>(f W X Y Z) \<Longrightarrow> (\<tau> \<Turnstile>\<delta> W) \<and> (\<tau> \<Turnstile>\<upsilon> X) \<and> (\<tau> \<Turnstile>\<upsilon> Y) \<and> (\<tau> \<Turnstile>\<upsilon> Z)"
|
|
by(auto simp: valid_def bot_fun_def invalid_def
|
|
def_scheme StrongEq_def OclValid_def false_def true_def
|
|
split: if_split_asm)
|
|
|
|
lemma cp_pre: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2'\<Longrightarrow> cp a3'
|
|
\<Longrightarrow> cp (\<lambda>X. PRE (self' X) (a1' X) (a2' X) (a3' X) )"
|
|
by(rule_tac f=PRE in cpI4, auto intro: cp\<^sub>P\<^sub>R\<^sub>E)
|
|
|
|
lemma cp_post: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp a3' \<Longrightarrow> cp res'
|
|
\<Longrightarrow> cp (\<lambda>X. POST (self' X) (a1' X) (a2' X) (a3' X) (res' X))"
|
|
by(rule_tac f=POST in cpI5, auto intro: cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T)
|
|
|
|
lemma cp0' : "f self a1 a2 a3 \<tau> = f (\<lambda> _. self \<tau>) (\<lambda> _. a1 \<tau>) (\<lambda> _. a2 \<tau>) (\<lambda> _. a3 \<tau>) \<tau>"
|
|
by (rule cp0[of _ "(a1,a2,a3)", simplified])
|
|
|
|
lemma cp [simp]: "cp self' \<Longrightarrow> cp a1' \<Longrightarrow> cp a2' \<Longrightarrow> cp a3' \<Longrightarrow> cp res'
|
|
\<Longrightarrow> cp (\<lambda>X. f (self' X) (a1' X) (a2' X) (a3' X))"
|
|
by(rule_tac f=f in cpI4, auto intro:cp0')
|
|
|
|
theorem unfold :
|
|
assumes "cp E"
|
|
and "(\<tau> \<Turnstile> \<delta> self) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2) \<and> (\<tau> \<Turnstile> \<upsilon> a3)"
|
|
and "\<tau> \<Turnstile> PRE self a1 a2 a3"
|
|
and " \<exists>res. (\<tau> \<Turnstile> POST self a1 a2 a3 (\<lambda> _. res))"
|
|
and "(\<And>res. \<tau> \<Turnstile> POST self a1 a2 a3 (\<lambda> _. res) \<Longrightarrow> \<tau> \<Turnstile> E (\<lambda> _. res))"
|
|
shows "\<tau> \<Turnstile> E(f self a1 a2 a3)"
|
|
apply(rule unfold'[of _ _ _ "(a1, a2, a3)", simplified])
|
|
by((rule assms)+)
|
|
|
|
lemma unfold2 :
|
|
assumes "cp E"
|
|
and "(\<tau> \<Turnstile> \<delta> self) \<and> (\<tau> \<Turnstile> \<upsilon> a1) \<and> (\<tau> \<Turnstile> \<upsilon> a2) \<and> (\<tau> \<Turnstile> \<upsilon> a3)"
|
|
and "\<tau> \<Turnstile> PRE self a1 a2 a3"
|
|
and "\<tau> \<Turnstile> POST' self a1 a2 a3" (* split constraint holds on post-state *)
|
|
and "\<And> res. (POST self a1 a2 a3 res) =
|
|
((POST' self a1 a2 a3) and (res \<triangleq> (BODY self a1 a2 a3)))"
|
|
shows "(\<tau> \<Turnstile> E(f self a1 a2 a3)) = (\<tau> \<Turnstile> E(BODY self a1 a2 a3))"
|
|
apply(rule unfold2'[of _ _ _ "(a1, a2, a3)", simplified])
|
|
by((rule assms)+)
|
|
end
|
|
|
|
|
|
end
|