citadelle-devel/examples/Bank_Test_Model.thy

239 lines
13 KiB
Plaintext

(******************************************************************************
* HOL-OCL
*
* 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.
******************************************************************************)
chapter{* Part ... *}
theory Bank_Test_Model
imports
FOCL.UML_OCL
begin
Class Account
Attributes account_id : Integer
balance : Integer
Context c: Account
Inv "\<zero> \<le>\<^sub>i\<^sub>n\<^sub>t (c .balance)"
Class Client
Attributes client_id : Integer
name : String
Association owner
Between Account [1 \<bullet>\<bullet> *] Role accounts
Client [1] Role owner
Association manages
Between Account [1 \<bullet>\<bullet> *] Role managed_accounts
Bank [1] Role bank
Class Bank
Attributes bank_name : String
End! (* Bang forces generation of the oo - datatype theory *)
Context Bank :: deposit (c : Client, account_id : Integer, amount:Integer)
Pre "def": "(\<delta> c) and (\<delta> account_id) and (\<delta> amount)" (* this mimics the syntax : c : Client[1], account_id : Integer[1] *)
Pre "pos": "\<zero> \<le>\<^sub>i\<^sub>n\<^sub>t amount"
Pre "(self .managed_accounts) ->exists\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))"
Post "let A' = self .managed_accounts ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))
->any\<^sub>S\<^sub>e\<^sub>t();
A = self .managed_accounts@pre ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))
->any\<^sub>S\<^sub>e\<^sub>t()
in (A' .balance) \<doteq> (A .balance +\<^sub>i\<^sub>n\<^sub>t amount)"
Context Bank :: withdraw (c : Client, account_id : Integer, amount:Integer)
Pre "def": "(\<delta> c) and (\<delta> account_id) and (\<delta> amount)" (* this mimics the syntax : c : Client[1], account_id : Integer[1] *)
Pre "\<zero> \<le>\<^sub>i\<^sub>n\<^sub>t amount"
Pre "(self .managed_accounts) ->exists\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and
((X .account_id) \<doteq> account_id) and
(amount \<le>\<^sub>i\<^sub>n\<^sub>t (X .balance)) )"
Post "let A' = self .managed_accounts ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))
->any\<^sub>S\<^sub>e\<^sub>t();
A = self .managed_accounts@pre ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))
->any\<^sub>S\<^sub>e\<^sub>t()
in (A' .balance) \<doteq> (A .balance -\<^sub>i\<^sub>n\<^sub>t amount)"
Context Bank :: get_balance (c : Client, account_id : Integer) : Integer
Pre "(\<delta> c) and (\<delta> account_id)" (* this mimics the syntax : c : Client[1], account_id : Integer[1] *)
Pre client_exists: "(self .managed_accounts) ->exists\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and
((X .account_id) \<doteq> account_id))"
Post spec: "let A = self .managed_accounts ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> account_id))
->any\<^sub>S\<^sub>e\<^sub>t()
in result \<triangleq> (A .balance)"
Post frame: "(Set{} :: \<cdot>Set(\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>)) ->oclIsModifiedOnly()"
(* (* from this point, the SORRY flag in UML_OCL.thy
(or declare [[quick_and_dirty = true]]) is currently
needed for the following to work *)
lemma emptyFrame: "(\<sigma>,\<sigma>') \<Turnstile> (Set{}->oclIsModifiedOnly()) \<Longrightarrow> \<sigma> = \<sigma>'"
sorry
lemma get_balance_is_query :
assumes *: "(\<sigma>,\<sigma>') \<Turnstile> ((bank :: \<cdot>Bank) .get_balance(c , a1) \<doteq> d)"
shows "\<sigma> = \<sigma>'"
sorry
lemma dot__withdraw_defined_mono_strong :
"\<tau> \<Turnstile> \<upsilon> (W .withdraw(X,Y,Z))
\<Longrightarrow> (\<tau> \<Turnstile> \<delta> W) \<and> (\<tau> \<Turnstile> \<delta> X) \<and> (\<tau> \<Turnstile> \<delta> Y) \<and> (\<tau> \<Turnstile> \<delta> Z)"
sorry
lemma dot__deposit_defined_mono_strong :
"\<tau> \<Turnstile> \<upsilon> (W .deposit(X,Y,Z))
\<Longrightarrow> (\<tau> \<Turnstile> \<delta> W) \<and> (\<tau> \<Turnstile> \<delta> X) \<and> (\<tau> \<Turnstile> \<delta> Y) \<and> (\<tau> \<Turnstile> \<delta> Z)"
sorry
lemma dot__get_balance_defined_mono_strong :
"\<tau> \<Turnstile> \<upsilon> (W .get_balance(X,Y))
\<Longrightarrow> (\<tau> \<Turnstile> \<delta> W) \<and> (\<tau> \<Turnstile> \<delta> X) \<and> (\<tau> \<Turnstile> \<delta> Y)"
sorry
lemmas [simp,code_unfold] = dot_accessor
lemma
assumes const_bank : "const bank"
assumes const_c : "const c"
assumes const_a1 : "const a1"
assumes *: "(\<sigma>,\<sigma>') \<Turnstile> ((bank :: \<cdot>Bank) .get_balance(c , a1) \<doteq> d)"
and **: "(\<sigma>',\<sigma>'') \<Turnstile> (bank .deposit(c, a1, a) \<triangleq> null)"
and ***: "(\<sigma>'',\<sigma>''') \<Turnstile> (bank .withdraw(c, a1, b) \<triangleq> null)"
shows "\<exists>\<sigma>''''. (\<sigma>''',\<sigma>'''') \<Turnstile> ((bank .get_balance(c , a1)) \<doteq> (d +\<^sub>i\<^sub>n\<^sub>t a -\<^sub>i\<^sub>n\<^sub>t b))"
proof -
have XXX: "\<And>\<tau> X. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon>(X)"
by (metis foundation18 foundation22 valid2 valid_bool_split)
have YYY: "\<And>\<tau> X. \<tau> \<Turnstile> (X \<doteq> d) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon>(X)"
by (simp add: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.defargs)
show "?thesis"
apply(insert * ** *** )
(* We get rid of the existential : since this is a query, putting \<sigma>'''' on \<sigma>''' is a good choice. *)
apply(rule_tac x = "\<sigma>'''" in exI)
(* first phase : we make all implicit definedness and validity knowledge explicit.
I e we perform Delta-closure and exploit is_query's. *)
apply(frule get_balance_is_query, hypsubst)
apply(frule XXX) back
apply(drule dot__withdraw_defined_mono_strong, clarify)
apply(frule XXX)
apply(drule dot__deposit_defined_mono_strong, clarify)
apply(frule YYY)
apply(drule dot__get_balance_defined_mono_strong, clarify)
apply(frule get_balance_is_query, hypsubst)
apply(subst UML_OCL.dot__get_balance_Bank, subst OclValid_def, subst (2) StrongEq_def, subst true_def,
simp only: option.inject eq_True Let_def)
apply(subgoal_tac "(\<sigma>''', \<sigma>'''') \<Turnstile> \<delta> bank \<and> (\<sigma>''', \<sigma>'''') \<Turnstile> \<upsilon> c \<and> (\<sigma>''', \<sigma>'''') \<Turnstile> \<upsilon> a1")
prefer 2
apply (meson const_OclValid1 const_OclValid2 const_a1 const_bank const_c)
apply(simp only: simp_thms if_True)
apply(subst (asm) UML_OCL.dot__get_balance_Bank, subst (asm) OclValid_def, subst (asm) (2) StrongEq_def, subst (asm) true_def,
simp only: option.inject eq_True Let_def)
apply(subgoal_tac "(\<sigma>, \<sigma>') \<Turnstile> \<delta> bank \<and> (\<sigma>, \<sigma>') \<Turnstile> \<upsilon> c \<and> (\<sigma>, \<sigma>') \<Turnstile> \<upsilon> a1")
prefer 2
apply (meson const_OclValid1 const_OclValid2 const_a1 const_bank const_c)
apply(simp only: simp_thms if_True)
oops
*)
(* TODO : Use Locales. *)
find_theorems (100) "dot\<g>\<e>\<t>095\<b>\<a>\<l>\<a>\<n>\<c>\<e>"
find_theorems (100) name:"\<d>\<e>\<p>\<o>\<s>\<i>\<t>"
definition val2Mon :: "('\<sigma>, '\<alpha>::null)val \<Rightarrow> ('\<alpha>,'\<sigma> state)MON\<^sub>S\<^sub>E"
where "val2Mon f \<equiv> (\<lambda>\<sigma>. if \<exists>\<sigma>'. \<exists>d. ((\<sigma>,\<sigma>') \<Turnstile> (f \<triangleq> d))
then Some(SOME(d,\<sigma>'). ((\<sigma>,\<sigma>') \<Turnstile> (f \<triangleq> (\<lambda>_. d))))
else None)"
definition "bind_SE' f1 f2 = bind_SE f1 (f2 o K)"
syntax (xsymbols)
"_bind_SE'" :: "[pttrn,('o,'\<sigma>)MON\<^sub>S\<^sub>E,('o','\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>E"
("(2 _ \<longleftarrow> _; _)" [5,8,8]8)
translations
"x \<longleftarrow> f; g" == "CONST bind_SE' (CONST val2Mon (f)) (% x . g)"
lemma get_balanceE :
assumes 1: "\<sigma> \<Turnstile>\<^sub>M\<^sub>o\<^sub>n ( r \<longleftarrow> (self :: \<cdot>Bank) .get_balance(c , a1) ; M r)"
and 2: "(\<sigma>,\<sigma>')\<Turnstile>(self .managed_accounts@pre) ->exists\<^sub>S\<^sub>e\<^sub>t(X | (X .owner@pre) \<doteq> c and
((X .account_id@pre) \<doteq> a1))"
and 3: "\<sigma>' = \<sigma>"
and 4: "(\<sigma>,\<sigma>')\<Turnstile>(let A = self .managed_accounts ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> a1))
->any\<^sub>S\<^sub>e\<^sub>t()
in result \<triangleq> (A .balance)) "
shows "\<sigma>' \<Turnstile>\<^sub>M\<^sub>o\<^sub>n (M (\<lambda>_. (result (\<sigma>,\<sigma>')))) "
oops
lemma get_balanceS :
assumes 1: "(\<sigma>,\<sigma>')\<Turnstile>(self .managed_accounts@pre) ->exists\<^sub>S\<^sub>e\<^sub>t(X | (X .owner@pre) \<doteq> c and
((X .account_id@pre) \<doteq> a1))"
and 2: "\<sigma>' = \<sigma>"
and 3: "(\<sigma>,\<sigma>')\<Turnstile>(let A = self .managed_accounts ->select\<^sub>S\<^sub>e\<^sub>t(X | (X .owner) \<doteq> c and ((X .account_id) \<doteq> a1))
->any\<^sub>S\<^sub>e\<^sub>t()
in result \<triangleq> (A .balance)) "
shows "(\<sigma> \<Turnstile>\<^sub>M\<^sub>o\<^sub>n ( r \<longleftarrow> (self :: \<cdot>Bank) .get_balance(c , a1) ; M r)) =
(\<sigma>' \<Turnstile>\<^sub>M\<^sub>o\<^sub>n (M (\<lambda>_. (result (\<sigma>,\<sigma>'))))) "
oops
lemma valid_sequence:
assumes client_account_defined : "\<forall> \<sigma> . (\<sigma>\<^sub>0, \<sigma>) \<Turnstile> bank .managed_accounts@pre->exists\<^sub>S\<^sub>e\<^sub>t(X|X .owner@pre \<doteq> c and (X .account_id@pre \<doteq> a1))"
shows
"\<sigma>\<^sub>0 \<Turnstile>\<^sub>M\<^sub>o\<^sub>n ( r \<longleftarrow> (bank :: \<cdot>Bank) .get_balance(c , a1) ;
_ \<longleftarrow> bank .deposit(c, a1, a) ;
_ \<longleftarrow> bank .withdraw(c , a1, b) ;
r' \<longleftarrow> bank .get_balance(c , a1) ;
assert\<^sub>S\<^sub>E (\<lambda>\<sigma>. ((\<sigma>,\<sigma>) \<Turnstile> (r +\<^sub>i\<^sub>n\<^sub>t a -\<^sub>i\<^sub>n\<^sub>t b \<doteq> r'))))"
(*apply(subst get_balanceS)
apply(rule client_account_defined[THEN spec])
apply(rule refl)
apply(simp only:Let_def)
apply(rule UML_Logic.StrongEq_L_refl)
*)
oops
end